如何存储递归遍历文件夹函数返回的所有.xlsm文件完整路径

问题根源 #

原代码存在三个核心问题：

• 用单个字符串variable存储路径，每次找到新文件都会覆盖之前的值，最终仅保留最后一个文件路径
• 递归调用时未将子文件夹遍历得到的路径合并到结果中
• 未过滤.xlsm文件，会收集所有类型的文件

解决方案1：让函数返回文件路径数组 #

修改递归函数，使其返回字符串数组，递归过程中合并当前文件夹与子文件夹的文件路径：

Function LoopAllSubFolders(ByVal folderPath As String) As String()
    Dim fileName As String
    Dim fullFilePath As String
    Dim numFolders As Long
    Dim folders() As String
    Dim i As Long
    Dim currentFiles() As String
    Dim subFiles() As String
    Dim fileCount As Long
    Dim combinedCount As Long
    Dim j As Long
    
    ' 确保路径末尾带反斜杠
    If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\"
    
    ' 收集当前文件夹下的xlsm文件
    fileName = Dir(folderPath & "*.xlsm", vbNormal)
    fileCount = 0
    While Len(fileName) <> 0
        fileCount = fileCount + 1
        ReDim Preserve currentFiles(1 To fileCount) As String
        currentFiles(fileCount) = folderPath & fileName
        fileName = Dir()
    Wend
    
    ' 收集当前文件夹下的子文件夹
    fileName = Dir(folderPath & "*.*", vbDirectory)
    numFolders = 0
    While Len(fileName) <> 0
        If Left(fileName, 1) <> "." Then
            fullFilePath = folderPath & fileName
            If (GetAttr(fullFilePath) And vbDirectory) = vbDirectory Then
                numFolders = numFolders + 1
                ReDim Preserve folders(1 To numFolders) As String
                folders(numFolders) = fullFilePath
            End If
        End If
        fileName = Dir()
    Wend
    
    ' 递归遍历子文件夹，合并路径数组
    For i = 1 To numFolders
        subFiles = LoopAllSubFolders(folders(i))
        If UBound(subFiles) >= 1 Then
            combinedCount = fileCount + UBound(subFiles)
            ReDim Preserve currentFiles(1 To combinedCount) As String
            For j = 1 To UBound(subFiles)
                fileCount = fileCount + 1
                currentFiles(fileCount) = subFiles(j)
            Next j
        End If
    Next i
    
    ' 处理空数组边界情况
    If fileCount = 0 Then
        ReDim currentFiles(1 To 0) As String
    End If
    
    LoopAllSubFolders = currentFiles
End Function

Sub loopAllSubFolderSelectStartDirectory()
    Dim allFiles() As String
    Dim i As Long
    
    allFiles = LoopAllSubFolders("Data\")
    
    ' 输出所有文件路径
    If UBound(allFiles) >= 1 Then
        For i = 1 To UBound(allFiles)
            Debug.Print allFiles(i)
        Next i
    Else
        Debug.Print "未找到任何xlsm文件"
    End If
End Sub

解决方案2：使用ByRef参数传递数组（更高效） #

通过ByRef参数共享数组，直接在递归过程中添加文件路径，避免数组合并的开销：

Sub CollectXLSMFiles(ByVal folderPath As String, ByRef fileList() As String)
    Dim fileName As String
    Dim fullFilePath As String
    Dim numFolders As Long
    Dim folders() As String
    Dim i As Long
    Dim currentCount As Long
    
    ' 确保路径末尾带反斜杠
    If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\"
    
    ' 收集当前文件夹下的xlsm文件
    fileName = Dir(folderPath & "*.xlsm", vbNormal)
    While Len(fileName) <> 0
        currentCount = UBound(fileList) + 1
        ReDim Preserve fileList(1 To currentCount) As String
        fileList(currentCount) = folderPath & fileName
        fileName = Dir()
    Wend
    
    ' 收集子文件夹
    fileName = Dir(folderPath & "*.*", vbDirectory)
    numFolders = 0
    While Len(fileName) <> 0
        If Left(fileName, 1) <> "." Then
            fullFilePath = folderPath & fileName
            If (GetAttr(fullFilePath) And vbDirectory) = vbDirectory Then
                numFolders = numFolders + 1
                ReDim Preserve folders(1 To numFolders) As String
                folders(numFolders) = fullFilePath
            End If
        End If
        fileName = Dir()
    Wend
    
    ' 递归遍历子文件夹
    For i = 1 To numFolders
        CollectXLSMFiles folders(i), fileList
    Next i
End Sub

Sub loopAllSubFolderSelectStartDirectory()
    Dim allFiles() As String
    
    ' 初始化空数组
    ReDim allFiles(1 To 0) As String
    
    CollectXLSMFiles "Data\", allFiles
    
    ' 输出所有文件路径
    If UBound(allFiles) >= 1 Then
        Dim i As Long
        For i = 1 To UBound(allFiles)
            Debug.Print allFiles(i)
        Next i
    Else
        Debug.Print "未找到任何xlsm文件"
    End If
End Sub

关键改进点 #

• 精准过滤.xlsm文件，避免无关文件干扰
• 使用数组存储所有路径，解决单个字符串覆盖的问题
• 递归时正确合并或追加子文件夹的文件路径
• 处理空数组边界情况，避免运行时错误

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