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