Re: Loop Through Files in Folder and check DateLastModified
Of course, me saying "it will work" was on the same basis as my code - untested, but in general it would work (except for the logic errors :))
Never mind... going back to my preferred method using native VBA functions, the following will list all files in a directory where the month is not equal to the current month. Optionally, you can pass it a File Spec ("*.XLS?") to limit the checking to just Excel workbooks, for example.
It has expanded a little, but that's only to do with listing the 'invalid' files. It will list up to 15 'invalid' files. If there are more, it will append an "and x other(s)..." message to the output
Public Function AllFilesDatedThisMonth(FPath As String, Optional fMask As String = "*.*") As Boolean
Dim fName As String
Dim ReturnVal As Boolean
Dim CountBad As Long
Dim BadFileList As String
'// Default to True
ReturnVal = True
'// FilePath should NOT have a terminating '/'
fName = Dir(FPath & "/" & fMask)
'// If no files found, then exit. The function value will default to 'False'
If fName = vbNullString Then
MsgBox "No files found...", vbExclamation
Exit Function
End If
Do While fName <> vbNullString
If Month(FileDateTime(FPath & "\" & fName)) <> Month(Date) Then
If CountBad < 16 Then
BadFileList = BadFileList & Format(FileDateTime(FPath & "\" & fName), "Mmm") & _
vbTab & fName & vbCrLf
End If
CountBad = CountBad + 1
ReturnVal = False
End If
fName = Dir
Loop
If BadFileList <> vbNullString Then
BadFileList = "The following files have an invalid date:" & vbCrLf & vbCrLf & _
BadFileList & _
IIf(CountBad > 15, vbCrLf & "and " & CStr(CountBad - 15) & " other(s)...", vbCrLf) & vbCrLf & _
vbCrLf & "Please download the latest reports and run this procedure again."
MsgBox BadFileList, vbExclamation
End If
End Function
Display More
You call it using something like
If Not AllFilesDatedThisMonth("c:\temp") Then Exit Sub
where you pass the directory to check.
If you want to limit the checking to a certain file mask, then use
If Not AllFilesDatedThisMonth("c:\temp", "*.XLS?") Then Exit Sub
