取所有文件夹名

需引用Microsoft Scripting Runtime

Option Explicit 

Function GetAllFolderName(FistFolder As String) '取所有文件夹名

　　If FistFolder = "" Then GetAllFolderName = Null: End
　　Dim Fso　　As New FileSystemObject
　　Dim Fol　　As Folder, Fol_ As Folder
　　Dim Fols() As String
　　Dim x　　  As Long, y As Long

　　x = 1: y = 1
　　ReDim Preserve Fols(1 To 1)

　　Fols(x) = FistFolder

　　Do
　　　　Set Fol = Fso.GetFolder(Fols(x))
　　　　For Each Fol_ In Fol.SubFolders
　　　　　　y = y + 1
　　　　　　ReDim Preserve Fols(1 To y)
　　　　　　Fols(y) = CStr(Fol_)
　　　　Next
　　　　DoEvents
　　　　x = x + 1
　　Loop Until x > y
　　GetAllFolderName = Fols
End Function