VBA遍历Excel文件代码仅支持单个文件夹，如何适配所有子文件夹？

要实现遍历所选目录下所有子文件夹内的Excel文件，我们可以借助FileSystemObject实现递归遍历，修改后的完整可运行代码如下：

Sub KeepColor()
    Dim strFolder   As String
    Dim fso         As Object
    Dim rootFolder  As Object
    
    ' 选择根文件夹
    With Application.FileDialog(4)
        If .Show Then
            strFolder = .SelectedItems(1)
        Else
            MsgBox "您未选择任何文件夹！", vbExclamation
            Exit Sub
        End If
    End With
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set rootFolder = fso.GetFolder(strFolder)
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    ' 调用递归子程序处理根文件夹及所有子文件夹
    ProcessFolder rootFolder
    
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Set fso = Nothing
    MsgBox "所有文件处理完成！", vbInformation
End Sub

' 递归处理文件夹的子程序
Sub ProcessFolder(folder As Object)
    Dim subFolder   As Object
    Dim strFile     As Object
    Dim wbk         As Workbook
    Dim wsh         As Worksheet
    Dim xRg         As Range
    
    ' 先处理当前文件夹下的所有Excel文件
    For Each strFile In folder.Files
        If LCase(strFile.Name) Like "*.xls*" Then
            On Error Resume Next ' 跳过损坏/加密的文件
            Set wbk = Workbooks.Open(strFile.Path)
            If Err.Number = 0 Then
                For Each wsh In wbk.Worksheets
                    For Each xRg In wsh.UsedRange
                        If xRg.DisplayFormat.Interior.ColorIndex = xlColorIndexNone Then
                            xRg.Interior.ColorIndex = xlColorIndexNone
                        Else
                            xRg.Interior.Color = xRg.DisplayFormat.Interior.Color
                        End If
                    Next xRg
                    wsh.UsedRange.FormatConditions.Delete
                Next wsh
                wbk.Close SaveChanges:=True
            End If
            Err.Clear
            On Error GoTo 0
        End If
    Next strFile
    
    ' 递归处理所有子文件夹
    For Each subFolder In folder.SubFolders
        ProcessFolder subFolder
    Next subFolder
End Sub

修改说明 #

• 采用FileSystemObject晚绑定方案，无需手动添加引用，直接运行即可
• 新增ProcessFolder递归函数，自动遍历所有层级的子文件夹
• 增加了异常捕获逻辑，遇到加密、损坏的Excel文件会自动跳过，不会中断整个处理流程
• 原有的颜色保留、条件格式删除的核心逻辑完全保留，和原有代码效果一致

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