Excel VBA遍历文件夹及子文件夹时数组值被重置的解决方法

方案一：使用模块级数组变量 #

将数组声明在模块的顶部（所有子过程之外），这样递归调用DoFolder时，数组不会被重新初始化，之前存储的路径会持续保留。

示例代码：

' 模块级数组，用于存储找到的文件路径
Dim filePaths() As String
Dim arrIndex As Integer

Sub StartSearch()
    Dim rootFolder As String
    rootFolder = "C:\Your\Target\Folder" ' 替换为你的目标根文件夹路径
    
    ' 初始化数组和索引
    ReDim filePaths(0 To 0)
    arrIndex = 0
    
    ' 启动递归遍历
    Call DoFolder(rootFolder)
    
    ' 遍历完成后，可按需处理数组中的路径
    Dim i As Integer
    For i = 0 To arrIndex - 1
        Debug.Print filePaths(i)
    Next i
End Sub

Sub DoFolder(folderPath As String)
    Dim fso As Object
    Dim folder As Object
    Dim subFolder As Object
    Dim file As Object
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set folder = fso.GetFolder(folderPath)
    
    ' 遍历当前文件夹内的文件
    For Each file In folder.Files
        ' 筛选以BACAPPC开头的xml文件
        If LCase(fso.GetExtensionName(file.Name)) = "xml" And Left(file.Name, 7) = "BACAPPC" Then
            ' 存入当前文件路径
            ReDim Preserve filePaths(0 To arrIndex)
            filePaths(arrIndex) = file.Path
            arrIndex = arrIndex + 1
            
            ' 查找并存入同文件夹下的AppTypeInfo.xml
            Dim appInfoPath As String
            appInfoPath = folderPath & "\AppTypeInfo.xml"
            If fso.FileExists(appInfoPath) Then
                ReDim Preserve filePaths(0 To arrIndex)
                filePaths(arrIndex) = appInfoPath
                arrIndex = arrIndex + 1
            End If
        End If
    Next file
    
    ' 递归遍历子文件夹
    For Each subFolder In folder.SubFolders
        Call DoFolder(subFolder.Path)
    Next subFolder
    
    ' 释放对象
    Set fso = Nothing
    Set folder = Nothing
    Set subFolder = Nothing
    Set file = Nothing
End Sub

方案二：通过ByRef传递数组 #

如果不想使用模块级变量，可以将数组通过ByRef（按引用）传递给递归子过程，确保每次调用操作的是同一个数组实例，避免数据丢失。

示例代码：

Sub StartSearch()
    Dim rootFolder As String
    Dim filePaths() As String
    Dim arrIndex As Integer
    
    rootFolder = "C:\Your\Target\Folder" ' 替换为你的目标根文件夹路径
    ReDim filePaths(0 To 0)
    arrIndex = 0
    
    ' 启动递归遍历，传递数组和索引
    Call DoFolder(rootFolder, filePaths, arrIndex)
    
    ' 处理遍历结果
    Dim i As Integer
    For i = 0 To arrIndex - 1
        Debug.Print filePaths(i)
    Next i
End Sub

Sub DoFolder(folderPath As String, ByRef filePathArr() As String, ByRef currentIndex As Integer)
    Dim fso As Object
    Dim folder As Object
    Dim subFolder As Object
    Dim file As Object
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set folder = fso.GetFolder(folderPath)
    
    ' 遍历当前文件夹内的文件
    For Each file In folder.Files
        If LCase(fso.GetExtensionName(file.Name)) = "xml" And Left(file.Name, 7) = "BACAPPC" Then
            ' 扩展数组并添加当前文件路径
            ReDim Preserve filePathArr(0 To currentIndex)
            filePathArr(currentIndex) = file.Path
            currentIndex = currentIndex + 1
            
            ' 检查并添加同文件夹下的AppTypeInfo.xml
            Dim appInfoPath As String
            appInfoPath = folderPath & "\AppTypeInfo.xml"
            If fso.FileExists(appInfoPath) Then
                ReDim Preserve filePathArr(0 To currentIndex)
                filePathArr(currentIndex) = appInfoPath
                currentIndex = currentIndex + 1
            End If
        End If
    Next file
    
    ' 递归遍历子文件夹
    For Each subFolder In folder.SubFolders
        Call DoFolder(subFolder.Path, filePathArr, currentIndex)
    Next subFolder
    
    ' 释放对象
    Set fso = Nothing
    Set folder = Nothing
    Set subFolder = Nothing
    Set file = Nothing
End Sub

核心要点 #

• 两种方案的核心逻辑都是避免递归过程中重新初始化数组：模块级变量在整个模块生命周期内保持状态；ByRef传递确保递归调用操作的是同一个数组实例。
• 使用ReDim Preserve扩展数组时，只会扩展数组末尾并保留原有数据，这是实现动态存储的关键。
• 代码逻辑为先找到目标文件，再关联存入同文件夹下的AppTypeInfo.xml路径，确保关联关系准确。

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