修改的一段递归文件代码

Sub ListFilesTest()
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show Then FolderPath$ = .SelectedItems(1) Else Exit Sub
    End With
    If Right(FolderPath, 1) <> "" Then FolderPath = FolderPath & ""
    
    filepaths = GetAllFiles(FolderPath)
    Debug.Print Join(filepaths, vbCr)
End Sub

Function GetAllFiles(ByVal FolderPath As String, Optional ReturnFiles As Boolean = True)  '使用2个字典但无需递归的遍历过程
    Dim i As Integer, j As Integer
    Dim dFolder, dFile, Fso
    Set dFolder = CreateObject("Scripting.Dictionary") '字典dFolder记录子文件夹的绝对路径名
    Set dFile = CreateObject("Scripting.Dictionary") '字典dFile记录文件名 (文件夹和文件分开处理)

    dFolder(FolderPath) = ""           '以当前路径FolderPath作为起始记录,以便开始循环检查

    Set Fso = CreateObject("Scripting.FileSystemObject")
    Do While i < dFolder.Count
        FolderKeys = dFolder.Keys
        For Each f In Fso.GetFolder(FolderKeys(i)).Files '遍历该子文件夹中所有文件 (注意仅从新的FolderKeys(i) 开始)
            j = j + 1
            dFile(j) = f.Path
        Next

        i = i + 1
        For Each fd In Fso.GetFolder(FolderKeys(i - 1)).SubFolders '遍历该文件夹中所有新的子文件夹
            dFolder(fd.Path) = " " & fd.Name & ""
        Next
    Loop

    If ReturnFiles = False Then
        GetAllFiles = dFolder.Keys
    Else
        GetAllFiles = dFile.Items
    End If


End Function

  

原文地址:https://www.cnblogs.com/nextseven/p/10834792.html