从同名子文件夹FY25中提取文件的VBA代码需求

原代码会遍历指定目录及其所有子文件夹的文件，现在需要修改为仅提取每个客户名称文件夹下FY25子文件夹中的文件（文件结构：根目录→客户名称文件夹→FY25/Pre-FY25）。

修改后的代码 #

Sub GetFilesFY25()
    Dim oFSO As Object
    Dim oFolder As Object, oCustomerFolder As Object, oFY25Folder As Object
    Dim oFile As Object, sf As Object
    Dim i As Integer, ws As Worksheet
    
    Set ws = ActiveSheet
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    ' 替换为你的根目录路径（所有客户文件夹的上级目录）
    Set oFolder = oFSO.GetFolder("File Path")
    
    i = 1 ' 初始化行号，避免第一行数据为空
    
    ' 遍历根目录下的所有客户文件夹
    For Each oCustomerFolder In oFolder.SubFolders
        ' 检查当前客户文件夹下是否存在FY25子文件夹
        If oFSO.FolderExists(oCustomerFolder.Path & "\FY25") Then
            Set oFY25Folder = oFSO.GetFolder(oCustomerFolder.Path & "\FY25")
            
            ' 处理FY25文件夹及其所有子文件夹的文件
            ProcessFolder oFY25Folder, ws, i
        End If
    Next oCustomerFolder
    
    MsgBox "文件提取完成，共提取 " & i - 1 & " 个文件", vbInformation
End Sub

' 递归处理文件夹及其子文件夹的文件
Private Sub ProcessFolder(ByVal targetFolder As Object, ByVal ws As Worksheet, ByRef rowNum As Integer)
    Dim oFile As Object, subFolder As Object
    
    ' 处理当前文件夹下的所有文件
    For Each oFile In targetFolder.Files
        ws.Cells(rowNum, 1) = targetFolder.Path
        ws.Cells(rowNum, 2) = oFile.Name
        ws.Cells(rowNum, 3) = "RO"
        ws.Cells(rowNum, 4) = oFile.DateLastModified
        rowNum = rowNum + 1
    Next oFile
    
    ' 递归处理所有子文件夹
    For Each subFolder In targetFolder.SubFolders
        ProcessFolder subFolder, ws, rowNum
    Next subFolder
End Sub

修改说明 #

• 拆分递归逻辑到单独的ProcessFolder过程，代码结构更清晰易维护
• 优先遍历根目录下的客户名称文件夹，仅处理包含FY25子文件夹的客户目录
• 仅对FY25文件夹及其子文件夹执行文件提取操作，精准匹配需求
• 初始化行号为1，修复原代码第一行数据为空的问题
• 添加提取完成提示框，直观反馈结果

内容的提问来源于stack exchange，提问作者C3POvary