需求： 指定一個文件夾，需要得到文件夾下第三層的子文件夾的路徑。
下面的程序，可以通過level的參數，指定遍歷到第幾層目錄，如果設定爲0，則遍歷所有子目錄
程序有一定的共同性，而且可以擴展。現在沒有時間，稍後在更新完整的版本
Private Sub Button1_Click()
Dim dctDict As Scripting.Dictionary
Dim varItem As Variant
Dim strDirPath As String
Dim cnt As Integer
Dim level As Integer
level = 3
Set dctDict = CreateObject("scripting.dictionary")
strDirPath = "D:/test/"
Range(Cells(20, 1), Cells(20, 100)).Clear
If GetFiles(strDirPath, dctDict, 3) Then
For Each varItem In dctDict
Cells(20 + cnt, 1) = cnt + 1
Cells(20 + cnt, 2) = varItem
cnt = cnt + 1
Next
End If
End Sub
Function GetFiles(strPath As String, dctDict As Scripting.Dictionary, level As Integer) As Boolean
Dim fsoSysObj As Scripting.FileSystemObject
Dim fdrFolder As Scripting.Folder
Dim fdrSubFolder As Scripting.Folder
Dim filFile As Scripting.File
Set fsoSysObj = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
Set fdrFolder = fsoSysObj.GetFolder(strPath)
If Err <> 0 Then
GetFiles = False
GoTo GetFiles_End
End If
On Error GoTo 0
If 1 >= level Then
For Each fdrSubFolder In fdrFolder.SubFolders
dctDict.Add fdrSubFolder.Path, fdrSubFolder.Path
Next fdrSubFolder
End If
If 1 < level Or 0 = level Then
For Each fdrSubFolder In fdrFolder.SubFolders
GetFiles fdrSubFolder.Path, dctDict, level - 1
Next fdrSubFolder
End If
GetFiles = True
GetFiles_End: Exit Function
End Function
注意，FileSystemObject和Dictionary對象，要引用scripting runtime 才能正常編譯。
工程---》引用----》MICROSOFT SCRIPTING RUNTIME
（日本版）ツール＞參照設定＞microsoft scripting runtime
參考文章：http://d-tune.javaeye.com/blog/481337
