Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Get File list from folders and subfolders Excel VBA

Tags:

excel

vba

I already have a script that gets list of file in a folder but I need to include subfolders as well, can you please help me modify this, I have tried to compile something from the answers found here but failed.

Sub getfiles()

Dim oFSO As Object
Dim oFolder As Object
Dim oFile As Object
Dim i As Integer


Set oFSO = CreateObject("Scripting.FileSystemObject")

Set oFolder = oFSO.getfolder("C:\Users\cirklta\Desktop\excel reports")

For Each oFile In oFolder.Files

If oFile.DateLastModified > Now - 7 Then

    Cells(i + 1, 1) = oFolder.Path
    Cells(i + 1, 2) = oFile.Name
    Cells(i + 1, 3) = "RO"
    Cells(i + 1, 4) = oFile.DateLastModified

    i = i + 1
    
End If

Next oFile
like image 603
Tadas Avatar asked Sep 12 '25 01:09

Tadas


1 Answers

Here's a non-recursive method:

Sub getfiles()

    Dim oFSO As Object
    Dim oFolder As Object
    Dim oFile As Object, sf
    Dim i As Integer, colFolders As New Collection, ws As Worksheet
    
    Set ws = ActiveSheet
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set oFolder = oFSO.getfolder("C:\Users\cirklta\Desktop\excel") 
    
    colFolders.Add oFolder          'start with this folder
    
    Do While colFolders.Count > 0      'process all folders
        Set oFolder = colFolders(1)    'get a folder to process
        colFolders.Remove 1            'remove item at index 1
    
        For Each oFile In oFolder.Files
            If oFile.DateLastModified > Now - 7 Then
                ws.Cells(i + 1, 1) = oFolder.Path
                ws.Cells(i + 1, 2) = oFile.Name
                ws.Cells(i + 1, 3) = "RO"
                ws.Cells(i + 1, 4) = oFile.DateLastModified
                i = i + 1
            End If
        Next oFile

        'add any subfolders to the collection for processing
        For Each sf In oFolder.subfolders
            colFolders.Add sf 
        Next sf
    Loop

End Sub
like image 164
Tim Williams Avatar answered Sep 13 '25 16:09

Tim Williams