Still celebrating National IT Professionals Day with 3 months of free Premium Membership. Use Code ITDAY17

x
?
Solved

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

Posted on 2008-10-06
3
Medium Priority
?
1,970 Views
Last Modified: 2012-05-05
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.
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

0
Comment
Question by:Jeremyw
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
3 Comments
 
LVL 120

Accepted Solution

by:
Rey Obrero (Capricorn1) earned 2000 total points
ID: 22654195



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

0
 
LVL 44

Expert Comment

by:GRayL
ID: 22654322
This snippett contains lines 28 thru 35 wrapped in an If statement
      If DatePart(FileItem.DateCreated) = Date()  Then
        ' 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
      End If

Open in new window

0
 
LVL 3

Author Closing Comment

by:Jeremyw
ID: 31503597
Thanks Cap.  That was exactly what I needed.
0

Featured Post

Free Tool: IP Lookup

Get more info about an IP address or domain name, such as organization, abuse contacts and geolocation.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

You need to know the location of the Office templates folder, so that when you create new templates, they are saved to that location, and thus are available for selection when creating new documents.  The steps to find the Templates folder path are …
After seeing numerous questions for Dynamic Data Validation I notice that most have used Visual Basic to solve the problem. This suggestion is purely formula based and can be used in multiple rows.
This Micro Tutorial will demonstrate in Google Sheets how to use the HYPERLINK function to create live links inside your spreadsheet.
This Micro Tutorial demonstrates in Microsoft Excel how to consolidate your marketing data by creating an interactive charts using form controls. This creates cool drop-downs for viewers of your chart to choose from.

721 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question