使用VBA遍历子文件夹文件：循环代码失效求技术排查

我来帮你排查下问题，你的循环代码有几个关键问题导致没法遍历子文件夹并正确调用解压宏：

问题分析 #

1. 未区分文件与文件夹：Dir("目标路径")会返回该目录下所有文件和子文件夹的名称，但你没有判断当前项是文件还是文件夹，没法进入子文件夹继续遍历。
2. 未传递解压参数：调用UnZipFile时没有传入要解压的文件路径，这个宏根本不知道要处理哪个文件，即使遍历到目标文件也无法工作。
3. 缺少递归遍历逻辑：原代码只遍历了根目录的项，没有进入子文件夹处理里面的文件，自然没法触及你说的5个子文件夹里的待解压文件。

解决方案 #

首先需要修改你的UnZipFile宏，让它接受一个文件路径参数（这样才能指定要解压的文件），然后用递归逻辑遍历所有子文件夹：

第一步：修改UnZipFile宏（添加参数）

' 修改后的UnZipFile，接受要解压的ZIP文件路径作为参数
Sub UnZipFile(zipFilePath As String)
    ' 这里保留你原本的解压代码，把其中的固定文件路径替换成传入的zipFilePath即可
    ' 举个常见的解压实现示例（如果你的代码不同，对应调整）：
    Dim shellObj As Object
    Set shellObj = CreateObject("Shell.Application")
    ' 解压到ZIP文件所在的目录
    shellObj.Namespace(Left(zipFilePath, InStrRev(zipFilePath, "\"))).CopyHere shellObj.Namespace(zipFilePath).Items
    Set shellObj = Nothing
End Sub

第二步：递归遍历所有子文件夹的宏（用FileSystemObject实现，更直观）

Sub LoopAllZipFiles()
    Dim fso As Object
    Dim rootFolder As Object
    Dim targetRootPath As String
    
    targetRootPath = "E:\Downloads\data\ADVANCED\2020\Feb\1\"
    
    ' 创建文件系统对象实例
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set rootFolder = fso.GetFolder(targetRootPath)
    
    ' 处理根目录下的ZIP文件
    ProcessFolderFiles rootFolder, fso
    ' 递归处理所有子文件夹
    ProcessSubFolders rootFolder, fso
    
    ' 释放对象
    Set rootFolder = Nothing
    Set fso = Nothing
    MsgBox "所有ZIP文件解压完成！", vbInformation
End Sub

' 处理单个文件夹下的所有ZIP文件
Sub ProcessFolderFiles(folder As Object, fso As Object)
    Dim fileObj As Object
    For Each fileObj In folder.Files
        ' 只处理ZIP格式的文件
        If LCase(fso.GetExtensionName(fileObj.Path)) = "zip" Then
            Call UnZipFile(fileObj.Path)
        End If
    Next fileObj
End Sub

' 递归处理子文件夹
Sub ProcessSubFolders(parentFolder As Object, fso As Object)
    Dim subFolderObj As Object
    For Each subFolderObj In parentFolder.SubFolders
        ' 先处理当前子文件夹里的文件
        ProcessFolderFiles subFolderObj, fso
        ' 继续递归下一层子文件夹
        ProcessSubFolders subFolderObj, fso
    Next subFolderObj
End Sub

替代方案：不用FileSystemObject，纯Dir实现

如果你不想用FileSystemObject，也可以用Dir结合属性判断来实现递归：

Sub LoopAllZipFilesWithDir()
    Dim rootPath As String
    rootPath = "E:\Downloads\data\ADVANCED\2020\Feb\1\"
    ' 启动遍历
    TraverseFolder rootPath
    MsgBox "所有ZIP文件解压完成！", vbInformation
End Sub

' 递归遍历指定文件夹及其子文件夹
Sub TraverseFolder(folderPath As String)
    Dim currentItem As String
    Dim fullItemPath As String
    
    ' 获取当前文件夹下的所有项（包括文件夹）
    currentItem = Dir(folderPath & "\", vbDirectory)
    
    Do While currentItem <> ""
        ' 跳过系统默认的.和..目录
        If currentItem <> "." And currentItem <> ".." Then
            fullItemPath = folderPath & "\" & currentItem
            
            ' 判断当前项是文件夹还是文件
            If (GetAttr(fullItemPath) And vbDirectory) = vbDirectory Then
                ' 是文件夹，递归遍历
                TraverseFolder fullItemPath
            Else
                ' 是文件，判断是否为ZIP
                If LCase(Right(currentItem, 4)) = ".zip" Then
                    Call UnZipFile(fullItemPath)
                End If
            End If
        End If
        currentItem = Dir
    Loop
End Sub

关键修改说明 #

• 给UnZipFile添加了路径参数，让它能处理指定的ZIP文件
• 加入了递归逻辑，确保所有子文件夹里的文件都能被遍历到
• 增加了ZIP文件的类型判断，避免误处理其他格式的文件

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