Count Files modified before date

[Christiaan]

Hello Board Members!

I am looking for a way to count files in a specified folder that are created on or before a certain date.
I need to do this for 2 file types (*.xlsx and *.PDF), that reside in two different folders.

This is the code I have to count ALL files in the folders:

Sub CountFiles()


Application.ScreenUpdating = False
Application.DisplayAlerts = False


'Set the paths
Dim PathEvaluations As String
Dim PathPDF As String
Dim PathA As String
Dim PathB As String


Dim CountEvaluations As Integer
Dim CountOldEvals As Integer
Dim CountPDF As Integer
Dim CountOldPDF As Integer


Dim MsgBoxTitle As String
Dim PurgeDate As Date


PathEvaluations = Worksheets("References").Range("B50").Value
PathPDF = Worksheets("References").Range("B51").Value
MsgBoxTitle = Worksheets("References").Range("B32").Value
PurgeDate = Worksheets("References").Range("B77").Value


'Count evaluation files
    PathA = PathEvaluations & "*.xlsx"
    Filename = Dir(PathA)


    Do While Filename <> ""
        CountEvaluations = CountEvaluations + 1
        Filename = Dir()
    Loop


'Count PDF files
    PathB = PathPDF & "*.pdf"
    Filename = Dir(PathB)


    Do While Filename <> ""
       CountPDF = CountPDF + 1
        Filename = Dir()
    Loop
    
    MsgBox "System maintenance:" & vbNewLine & vbNewLine & _
    CountEvaluations & " files found in: evaluations folder" & vbNewLine & _
    "of which " & CountOldEvals & " are from before: " & PurgeDate & " and can be deleted!" & vbNewLine & vbNewLine & _
    CountPDF & " files found in: pdf folder" & vbNewLine & _
    "of which " & CountOldPDF & " are from before: " & PurgeDate & " and can be deleted!", vbInformation, MsgBoxTitle   


End Sub

Counting ALL the files in the 'evaluation' and 'pdf' folder works just fine. I am looking for the additional code to do a count if the date is before 'purgedate'.

Any tips are greatly appreciated!

 

[tlowry]

I felt that a rewrite was warranted here. To get to the file information, I used the FileSystemObject approach.

The macro GetFileCount does the work and is called by test.

Sub test()
    [B][COLOR=#008000]' --------------------------------------
    '   set these to your environment
[/COLOR][/B]    Const wCard = ".xlsm"
    Const sPath = "C:\Temp\"
    Const dDate = #10/1/2015#
    
    Dim lCount As Long
    Dim lOld As Long
    
   [COLOR=#008000][B] '-----------------------------------------
    '   run macro[/B][/COLOR]
    GetFileCount sPath, wCard, dDate, lCount, lOld
    
    '-----------------------------------------
    '   Display results
    Select Case lCount
        Case Is > 0
            MsgBox "In folder " & sPath & vbCrLf _
             & "there are " & lCount & " files like " & wCard & vbCrLf _
                & lOld & " created before " & dDate
        Case Else
            MsgBox "No files meet the discription: " & sPath & " * " & wCard
    End Select

End Sub

Sub GetFileCount(strPath, ext, dDate, icount, iOld)
    Dim objFSO As Object
    Dim objFolder As Object
    Dim objFile As Object
    
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    On Local Error GoTo ender
    
    Set objFolder = objFSO.GetFolder(strPath)
    If objFolder.Files.Count = 0 Then Exit Sub
    For Each objFile In objFolder.Files
       If objFile.Name Like "*" & ext Then
           icount = icount + 1
           If DateDiff("s", dDate, objFile.datecreated) > 0 Then iOld = iOld + 1
       End If
    Next objFile
ender:
    If Err.Number <> 0 Then
        MsgBox Err.Description
    End If
End Sub