excel - Pull from subfolders with same name - Stack Overflow

admin管理员组

文章数量:1394212

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

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

• excel
• vba

Share Improve this question Follow edited Mar 20 at 19:58 CommunityBot 111 silver badge asked Mar 11 at 19:30 C3POvaryC3POvary 1544 bronze badges 2

• So different folders named FY25 are located in different subfolders? – Shrotter Commented Mar 11 at 19:41
• Yeah, so the file structure is "Client Name" and then inside "Client Name" are two subfolders which are FY25 and Pre-FY25. I only need it to read FY25 for each "Client Name" folder. – C3POvary Commented Mar 11 at 19:44

Add a comment  | 

1 Answer 1

Sorted by: Reset to default 2

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

本文标签： excelPull from subfolders with same nameStack Overflow