需引用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