Question : Retrieve list of all files in folder & subfolders with DateCreate property equal to today

I have some VBA code that runs every day in Access and creates a few hundred reports. With all the variables it is possible that over 10,000 reports could be run in a day. What I'm trying to find out is how many reports were actually created today.

Using the code below, I'm able to list all files in a directory & sub-directories but I only want to see files that were created today. Is it possible to query the file properties and only list that data?

The attached code is in Excel, but I can use Access as well if there is something available.

Code Snippet:

         
           
             1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:

           
           
             Sub TestListFilesInFolder()
    Workbooks.Add ' create a new workbook for the file list
    ' add headers
    With Range("A1")
        .Formula = "Folder contents:"
        .Font.Bold = True
        .Font.Size = 12
    End With
    Range("A3").Formula = "File Name:"
    Range("D3").Formula = "Date Created:"
    Range("A3:H3").Font.Bold = True
    ListFilesInFolder "X:\Co50Reports\", True
    ' list all files included subfolders
End Sub
 
 
Sub ListFilesInFolder(SourceFolderName As String, IncludeSubfolders As Boolean)
' lists information about the files in SourceFolder
' example: ListFilesInFolder "C:\FolderName\", True
Dim FSO As Scripting.FileSystemObject
Dim SourceFolder As Scripting.Folder, SubFolder As Scripting.Folder
Dim FileItem As Scripting.File
Dim r As Long
    Set FSO = New Scripting.FileSystemObject
    Set SourceFolder = FSO.GetFolder(SourceFolderName)
    r = Range("A65536").End(xlUp).Row + 1
    For Each FileItem In SourceFolder.Files
        ' display file properties
        Cells(r, 1).Formula = FileItem.Path & FileItem.Name
        Cells(r, 2).Formula = FileItem.DateCreated
        ' use file methods (not proper in this example)
'        FileItem.Copy "C:\FolderName\Filename.txt", True
'        FileItem.Move "C:\FolderName\Filename.txt"
'        FileItem.Delete True
        r = r + 1 ' next row number
    Next FileItem
    If IncludeSubfolders Then
        For Each SubFolder In SourceFolder.SubFolders
            ListFilesInFolder SubFolder.Path, True
        Next SubFolder
    End If
    Columns("A:H").AutoFit
    Set FileItem = Nothing
    Set SourceFolder = Nothing
    Set FSO = Nothing
    ActiveWorkbook.Saved = True
End Sub

           
         

Open in New Window

Select All

Answer : Retrieve list of all files in folder & subfolders with DateCreate property equal to today

                       
         
           
             1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:

           
           
             Sub ListFilesInFolder(SourceFolderName As String, IncludeSubfolders As Boolean)
' lists information about the files in SourceFolder
' example: ListFilesInFolder "C:\FolderName\", True
Dim FSO As Scripting.FileSystemObject
Dim SourceFolder As Scripting.Folder, SubFolder As Scripting.Folder
Dim FileItem As Scripting.File
Dim r As Long
    Set FSO = New Scripting.FileSystemObject
    Set SourceFolder = FSO.GetFolder(SourceFolderName)
    r = Range("A65536").End(xlUp).Row + 1
    For Each FileItem In SourceFolder.Files
        ' display file properties
'check if the datecreated = date()
    if datevalue(FileItem.DateCreated)=Date() then
 
        Cells(r, 1).Formula = FileItem.Path & FileItem.Name
        Cells(r, 2).Formula = FileItem.DateCreated
        ' use file methods (not proper in this example)
'        FileItem.Copy "C:\FolderName\Filename.txt", True
'        FileItem.Move "C:\FolderName\Filename.txt"
'        FileItem.Delete True
        r = r + 1 ' next row number
 
    end if
    Next FileItem
    If IncludeSubfolders Then
        For Each SubFolder In SourceFolder.SubFolders
            ListFilesInFolder SubFolder.Path, True
        Next SubFolder
    End If
    Columns("A:H").AutoFit
    Set FileItem = Nothing
    Set SourceFolder = Nothing
    Set FSO = Nothing
    ActiveWorkbook.Saved = True
End Sub

           
         

Open in New Window

Select All