excelvba

Pull from subfolders with same name


This code extracts all of the files within a set of folders and their subfolders.

I need to extract from subfolders called FY25.

Subfolders named FY25 are located in different folders.
The file structure is "Client Name" then inside are two subfolders FY25 and Pre-FY25.
I need to read FY25 for each "Client Name" folder.

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("File Path")
    
    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 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

Solution

  • So you could include a name check of the current processed folder before checking the files.

    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("File Path")
        
        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
             
            If oFolder.Name = "FY25" then   'check the folder name
               For Each oFile In oFolder.Files
                   If oFile.DateLastModified 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
             End If
    
            'add any subfolders to the collection for processing
            For Each sf In oFolder.subfolders
                colFolders.Add sf
            Next sf
        Loop
    
    End Sub