取当前路径所有文件夹的自定义函数

取当前路径所有文件夹的自定义函数

在跨文件夹进行合并汇总的时候经常要获得所有文件夹的路径，下面的自定义函数返回一个下标从1开始的一维数组，以每个文件夹的路径为值，包括当前文件夹 Function Directory(Path$) Dim mypath, arr(), i, j, mydir$

Application.ScreenUpdating = False ReDim arr(1 To 1000)

arr(1) = ThisWorkbook.Path & \i = 1 j = 1

Do While arr(i) <> \

mydir = Dir(arr(i), vbDirectory) Do While mydir <> \

If mydir <> \

If GetAttr(arr(i) & mydir) = vbDirectory Then j = j + 1

arr(j) = arr(i) & mydir & \End If End If

mydir = Dir Loop i = i + 1 Loop

ReDim Preserve arr(1 To i - 1) Directory = arr

Application.ScreenUpdating = True End Function

调用示例 Sub test() Dim arr()

arr = Directory(ThisWorkbook.Path & \Debug.Print arr(1)

Debug.Print UBound(arr) End Sub