Solved

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

Posted on 2008-10-06
3
1,934 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

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

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

This tutorial explains how to create a series of drop-down lists that are dependent upon prior selections to guide (“force”) the user to make the correct selection and reduce data errors within Microsoft Excel. Excel 2010 was used for this tutorial;…
Workbook link problems after copying tabs to a new workbook? David Miller (dlmille) Intro Have you either copied sheets to a new workbook, and after having saved and opened that workbook, you find that there are links back to the original sou…
The viewer will learn how to create a normally distributed random variable in Excel, use a normal distribution to simulate the return on an investment over a period of years, Create a Monte Carlo simulation using a normal random variable, and calcul…
The viewer will learn how to create two correlated normally distributed random variables in Excel, use a normal distribution to simulate the return on different levels of investment in each of the two funds over a period of ten years, and, create a …

867 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

20 Experts available now in Live!

Get 1:1 Help Now