listing files in subfolders

[BBird]

I am trying to list all based based on the last accessed date ans show file name, date created, modified, and accessed. As well as give a file count.

I have gotten the code to work for a specific folder, but cannot figure out how to modify it to list the files in any subfolders. The code I currently am using is below. Can someone kindly give me a hand please. (As a side note, I got this code from a post of GTO's in March of 2010)

Option Explicit
    
Sub filelist()
Dim rng As Range
'Dim RowNo As Integer
'Dim NoOfFiles As Integer
'Dim foundfilepath As Integer
Dim strFilePath As String
Dim FSO As Object
Dim fsoSourceFolder As Object
Dim fsoFileItem As Object
Dim r As Long ' Integer
Dim lFileMatchCount As Long
    
    '// For testing//
    'strFilePath = ThisWorkbook.Path & "\Temp\"
    strFilePath = "C:\test\"
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    
    If Not FSO.FolderExists(strFilePath) Then
        MsgBox "Error in Path", 0, vbNullString
        Exit Sub
    End If
    
    Set fsoSourceFolder = FSO.GetFolder(strFilePath)
    
    r = 2
    
    With Worksheets("FileChooser")
        For Each fsoFileItem In fsoSourceFolder.Files
            If fsoFileItem.DateLastModified < #1/1/2004# Then
                .Cells(r, 2).Formula = fsoFileItem.Name
                .Cells(r, 3).Formula = fsoFileItem.DateCreated
                .Cells(r, 4).Formula = fsoFileItem.DateLastModified
                .Cells(r, 5).Formula = fsoFileItem.DateLastAccessed
                r = r + 1
                lFileMatchCount = lFileMatchCount + 1
            End If
        Next fsoFileItem
        .Range("B1:E1").Value = Array("Name", "Created", "Modified", "Accessed")
        .Range("B1:E1").Font.Bold = True
        .Range("B:E").EntireColumn.AutoFit
        
        .Range("G1:H1").Value = Array("Matching Files", "Folder Files Count")
        .Range("G1:H1").Font.Bold = True
        .Range("G2:H2").Value = Array(lFileMatchCount, fsoSourceFolder.Files.Count)
        .Range("G1:H1").EntireColumn.AutoFit
End Sub

 

[MisterBate5]

Try the following (changes in BLUE):

Option Explicit
 
[COLOR=blue]Sub filelist()[/COLOR]
[COLOR=blue] Call filelist_folder("C:\test\")[/COLOR]
[COLOR=blue]end Sub[/COLOR]
 
[COLOR=blue]Sub filelist_folder(aFolder as string)[/COLOR]
Dim rng As Range
'Dim RowNo As Integer
'Dim NoOfFiles As Integer
'Dim foundfilepath As Integer
Dim strFilePath As String
Dim FSO As Object
Dim fsoSourceFolder As Object
Dim fsoFileItem As Object
Dim r As Long ' Integer
Dim lFileMatchCount As Long
 
    '// For testing//
    'strFilePath = ThisWorkbook.Path & "\Temp\"
    strFilePath = [COLOR=blue]aFolder[/COLOR]
 
    Set FSO = CreateObject("Scripting.FileSystemObject")
 
    If Not FSO.FolderExists(strFilePath) Then
        MsgBox "Error in Path", 0, vbNullString
        Exit Sub
    End If
 
    Set fsoSourceFolder = FSO.GetFolder(strFilePath)
 
    r = 2
 
    With Worksheets("FileChooser")
        For Each fsoFileItem In fsoSourceFolder.Files
            If fsoFileItem.DateLastModified < #1/1/2004# Then
                .Cells(r, 2).Formula = fsoFileItem.Name
                .Cells(r, 3).Formula = fsoFileItem.DateCreated
                .Cells(r, 4).Formula = fsoFileItem.DateLastModified
                .Cells(r, 5).Formula = fsoFileItem.DateLastAccessed
                r = r + 1
                lFileMatchCount = lFileMatchCount + 1
            End If
        Next fsoFileItem
        .Range("B1:E1").Value = Array("Name", "Created", "Modified", "Accessed")
        .Range("B1:E1").Font.Bold = True
        .Range("B:E").EntireColumn.AutoFit
 
        .Range("G1:H1").Value = Array("Matching Files", "Folder Files Count")
        .Range("G1:H1").Font.Bold = True
        .Range("G2:H2").Value = Array(lFileMatchCount, fsoSourceFolder.Files.Count)
        .Range("G1:H1").EntireColumn.AutoFit
[COLOR=blue]   End With[/COLOR]
End Sub

You can then change the string "C:\test\" to whatever you need.

 

[BBird]

Perfect! Thanks for the help!

 

[BBird]

The code worked fine with the test folder (on our network) I was using that had only one only sub folder. However, when I moved it to a network folder farther up the tree, it did not populate down through all the subfolders.

 

[MisterBate5]

So you want a list of files in a folder plus all the subfolders? Then you need recursion (a function calling itself) and you'll need to be careful about how the results are output, so that when processing subfolders the output doesn't overwrite what you already output.

Try:

Option Explicit
Dim FSO As Object
 
Sub filelist()
    Dim lFileCounts As Variant
    Set FSO = CreateObject("Scripting.FileSystemObject")
 
    lFileCounts = filelist_folder("C:\Users\batemans\Documents\_Deals-GE\Finances\Forecasts\Forecast 2011-01 Jan 11", 2)
    With Worksheets("FileChooser")
        .Range("B1:E1").Value = Array("Name", "Created", "Modified", "Accessed")
        .Range("B1:E1").Font.Bold = True
        .Range("B:E").EntireColumn.AutoFit
 
        .Range("G1:H1").Value = Array("Matching Files", "Folder Files Count")
        .Range("G1:H1").Font.Bold = True
        .Range("G2:H2").Value = lFileCounts
        .Range("G1:H1").EntireColumn.AutoFit
   End With
End Sub
 
Function filelist_folder(strFilePath As String, r As Long) As Variant
Dim rng As Range
'Dim RowNo As Integer
'Dim NoOfFiles As Integer
'Dim foundfilepath As Integer
Dim fsoSourceFolder As Object
Dim fsoFileItem As Object
Dim fsoFolderItem As Object
Dim lFileMatchCount As Long
Dim lSourceFileCount As Long
Dim lFileCounts As Variant
Dim lSubfolderCounts As Variant
Dim i As Integer
 
    '// For testing//
    'strFilePath = ThisWorkbook.Path & "\Temp\"
 
    If Not FSO.FolderExists(strFilePath) Then
        MsgBox "Error in Path", 0, vbNullString
        Exit Function
    End If
 
    Set fsoSourceFolder = FSO.GetFolder(strFilePath)
 
    With Worksheets("FileChooser")
        For Each fsoFileItem In fsoSourceFolder.Files
            If fsoFileItem.DateLastModified < #1/1/2004# Then
                .Cells(r, 2).Formula = fsoFileItem.Name
                .Cells(r, 3).Formula = fsoFileItem.DateCreated
                .Cells(r, 4).Formula = fsoFileItem.DateLastModified
                .Cells(r, 5).Formula = fsoFileItem.DateLastAccessed
                r = r + 1
                lFileMatchCount = lFileMatchCount + 1
            End If
        Next fsoFileItem
        lFileCounts = Array(lFileMatchCount, fsoSourceFolder.Files.Count)
        For Each fsoFolderItem In fsoSourceFolder.subFolders
            lSubfolderCounts = filelist_folder(fsoFolderItem.Path, r)
            For i = LBound(lFileCounts) To UBound(lFileCounts)
                lFileCounts(i) = lFileCounts(i) + lSubfolderCounts(i)
            Next i
        Next fsoFolderItem
   End With
   
   filelist_folder = lFileCounts
   
End Function

Changes:
* only one FSO object (not one per folder processed)
* moved formatting to main sub
* changed the sub that processes a folder into a function
* added a return from the function to track files processed/files matching

 

[BBird]

Thanks again! Works like I wanted it to this time. I will try to study this code a bit and learn from it.

 

[MisterBate5]

Pleasure. Easiest way to learn from the code is to use the debugger to walk through it as it executes, and to set "watches" on the variables. Happy learning.

 

[Phlugg]

Hi MrBate5,

This looks perfect for exactly what I'm trying to do too, however, when I try and run it in excel 2007 I get an error on the line;

run time error 9, object out of range for the following line

With Worksheets("FileChooser")

Any idea how I can fix it? - (and I'm not very good with VB either..)

Regards,

Nick.

 

[BBird]

You need to change "FileChooser" to the name of your worksheet the code is running in.

 

[Phlugg]

Hi bbird - thanks. But I'm being a bit slow and I don't quite understand your reply. Do you mean the file name of my spreadsheet, the tab name I want the results in or the name of the module? Or something all together different. Treat as if I am really stupid.....and you won't be far wrong. Thanks, Nick.