Code: Select all
Option Explicit
Function FileExists(strFullName As Variant) As Boolean
FileExists = Not (Dir(strFullName) = "")
End Function
Function FileInUse(strFullName As String) As Boolean
Dim f As Integer
On Error Resume Next
f = FreeFile
Open strFullName For Input Lock Read As #f
Close #f
FileInUse = (Err = 70)
End Function
Function FileAvailable(strFullName As String) As Boolean
If FileExists(strFullName) Then
FileAvailable = Not FileInUse(strFullName)
End If
End Function
Sub A01_RunDailyProcess()
'''''''''''''''''''''''''''
'File Checker with option to exit
'Source Files
arrFiles1 = Array( _
"Report 5.2 excluding charged off accounts - " & Format(strDateBIFile, "yyyy-mm-dd") & " updated.xls", _
"Report 5.8- - " & Format(strDateBIFile, "yyyy-mm-dd") & ".xls", _
"Report 5.16-5.19 - " & Format(strDateBIFile, "yyyy-mm-dd") & ".xls", _
"Replacement Account Query 1 - " & Format(strDateWork, "dd-mm-yy") & ".xls")
'Destination Files
arrFiles2 = Array( _
"1. Month " & strMnth & " 5.8 Consolidated.xls", _
"2. Month " & strMnth & " 5.17 Consolidated.xls", _
"3. Month " & strMnth & " 5.18 Consolidated.xls", _
"4. Month " & strMnth & " 5.19 Consolidated.xls", _
"5. Month " & strMnth & " Daily Walk *.xls", _
"5a. Month " & strMnth & " Replacement Accounts.xls", _
"6. Month " & strMnth & " Calendarisation Impact and Total Performance To Date.xls")
varInfo = ""
For Each varFile In arrFiles1
If FileAvailable(strPath1 & varFile) = False Then
varInfo = varInfo & strPath1 & varFile & vbCrLf & vbCrLf
End If
Next
For Each varFile In arrFiles2
If FileAvailable(strPath2 & varFile) = False Then
varInfo = varInfo & strPath2 & varFile & vbCrLf & vbCrLf
End If
Next
If varInfo <> "" Then
Msg = vbCrLf & "File Checker"
Msg = Msg & vbCrLf & vbCrLf & "The following files are not available."
Msg = Msg & vbCrLf & vbCrLf & varInfo
Msg = Msg & vbCrLf & vbCrLf & "Process Aborted"
MsgBox Msg, vbCritical, "File Checker"
varInfo = ""
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Exit Sub
Else
Msg = vbCrLf & "File Checker"
Msg = Msg & vbCrLf & vbCrLf & "All files are available."
Msg = Msg & vbCrLf & vbCrLf & "Do you wish to continue?"
If MsgBox(Msg, vbQuestion + vbYesNo, "Run Daily Process") = vbNo Then
Msg = vbCrLf & "Run Daily Process"
Msg = Msg & vbCrLf & vbCrLf & "Process Aborted."
Msg = Msg & vbCrLf & vbCrLf
MsgBox Msg, vbCritical, "Run Daily Process"
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Exit Sub
End If
End If
'''''''''''''''
End Sub
I am having a problem with the file: "5. Month " & strMnth & " Daily Walk *.xls" (Note the wildcard - There is further variable text in the filename)
If I rename the file (example precede the filename with an x), the file exists function works as expected.
However, if the file is in use, the Fileinuse function is not capturing the fact and continues incorrectly.
Any idea's what would cause this? The Fileinuse function works for all other files (without wildcards).