【VBA】配下のフォルダ一覧を取得する

こんにちは。
本日は、指定のパスの下にあるフォルダパスを取得するサンプルです。
下まで探しに行ってくれます。
では、サンプルです。

Option Explicit

Private ThisWs As Worksheet
Private ThisPath As String
Private TaishoFolderArr() As String

Sub Main()

    ' 初期値の取得
    Set ThisWs = ThisWorkbook.Worksheets(1)
    ThisPath = ThisWorkbook.path

    ' 検索対象のフォルダを抽出
    Call GetTaishoFolder(ThisPath)

    ' 余分に拡大した要素を削除する
    If UBound(TaishoFolderArr) > 0 Then
        ReDim Preserve TaishoFolderArr(UBound(TaishoFolderArr) - 1)
    End If

End Sub

Private Sub GetFolderPath(ByVal path As String)

    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Dim objFolder As Object
    Set objFolder = fso.GetFolder(path)

    TaishoFolderArr(UBound(TaishoFolderArr)) = path
    ReDim Preserve TaishoFolderArr(UBound(TaishoFolderArr) + 1)

    Dim f As Object
    For Each f In objFolder.SubFolders
       Call GetFolderPath(path & "\" & f.name)
    Next f

    Set fso = Nothing

End Sub

TaishoFolderArrに配下のフォルダパスが格納されます。
あとは、この配列を使用して後続の処理をしていくだけです。
非常に便利ですね。
以上です。