采用字典记录中间结果的方法，同样来达到遍历所所有子文件的目的

Sub ListFilesTest()

With Application.FileDialog(msoFileDialogFolderPicker)

If .Show Then myPath$ = .SelectedItems(1) Else Exit Sub

End With

If Right(myPath, 1) <> "" Then myPath = myPath & ""

MsgBox "List Files:" & vbCr & Join(ListAllFsoDic(myPath), vbCr)

MsgBox "List SubFolders:" & vbCr & Join(ListAllFsoDic(myPath, 1), vbCr)

End Sub

Function ListAllFsoDic(myPath$, Optional k = 0) '使用2个字典但无需递归的遍历过程

Dim i&, j&

Set d1 = CreateObject("Scripting.Dictionary") '字典d1记录子文件夹的绝对路径名

Set d2 = CreateObject("Scripting.Dictionary") '字典d2记录文件名 （文件夹和文件分开处理）

d1(myPath) = ""           '以当前路径myPath作为起始记录，以便开始循环检查

Set fso = CreateObject("Scripting.FileSystemObject")

Do While i < d1.Count

'当字典1文件夹中有未遍历处理的key存在时进行Do循环 直到 i=d1.Count即所有子文件夹都已处理时停止

kr = d1.Keys '取出文件夹中所有的key即所有子文件夹路径 （注意每次都要更新）

For Each f In fso.GetFolder(kr(i)).Files '遍历该子文件夹中所有文件 （注意仅从新的kr(i) 开始）

j = j + 1: d2(j) = f.Name

'把该子文件夹内的所有文件名作为字典Item项加入字典d2 (为防止文件重名不能用key属性)

Next

i = i + 1 '已经处理过的子文件夹数目 i +1 （避免下次产生重复处理）

For Each fd In fso.GetFolder(kr(i - 1)).SubFolders '遍历该文件夹中所有新的子文件夹

d1(fd.Path) = " " & fd.Name & ""

'把新的子文件夹路径存入字典d1以便在下一轮循环中处理

Next

Loop

If k Then ListAllFsoDic = d1.Keys Else ListAllFsoDic = d2.Items

'如果参数=1则列出字典d1中所有子文件夹的路径名 (如使用d1.Items则仅列出子文件夹名称不含路径)

'如果参数=0则默认列出字典d2中Items即所有文件名

End Function