Solved

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

Posted on 2008-10-06
3
1,924 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
3 Comments
 
LVL 119

Accepted Solution

by:
Rey Obrero earned 500 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

Maximize Your Threat Intelligence Reporting

Reporting is one of the most important and least talked about aspects of a world-class threat intelligence program. Here’s how to do it right.

Join & Write a Comment

I originally created this report in Crystal Reports 2008 where there is an option to underlay sections. I initially came across the problem in Access Reports where I was unable to run my border lines down through the entire page as I was using the P…
This code takes an Excel list of URL’s and adds a header titled “URL List”. It then searches through all URL’s in column “A”, looking for duplicates. When a duplicate is found, it is moved to the top of the list. The duplicate URL’s are then highlig…
The viewer will learn how to use the =DISCRINV command to create a discrete random variable, use this command to model a set of probabilities and outcomes in a Monte Carlo simulation, and learn how to find the standard deviation of a set of probabil…
Graphs within dashboards are meant to be dynamic, representing data from a period of time that will change each time the dashboard is updated with new data. Rather than update each graph to point to a different set within a static set of data, t…

747 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

Need Help in Real-Time?

Connect with top rated Experts

9 Experts available now in Live!

Get 1:1 Help Now