B-Teck!

お仕事からゲームまで幅広く

【VBA】Dir関数で指定パスのサブフォルダを全て取得する

'/**
' * getTargetFolders
' * 与えられたパス配下のフォルダをサブフォルダまで配列で取得する
' * @param  strDirectoryPath パス
' * @return フォルダ名のString配列
' */
Function getTargetFolders(ByVal strDirectoryPath As String) As String()
    
    Dim buf As String
    Dim i As Long: i = 0
    Dim folders() As String: ReDim folders(0)
    Dim nowPath As String
    
    folders(0) = strDirectoryPath
    
    '親フォルダループ
    Do
        nowPath = folders(i) & "\"
        buf = Dir(nowPath, vbDirectory)
        '子フォルダループ
        Do While buf <> ""
            If GetAttr(nowPath & buf) = vbDirectory _
               And buf <> "." And buf <> ".." Then
               
                '配列末尾に格納
                ReDim Preserve folders(UBound(folders) + 1)
                folders(UBound(folders)) = nowPath & buf
                    
            End If
            buf = Dir()
        Loop
        
        'フォルダ走査完了
        If i = UBound(folders) Then
            Exit Do
        Else
            i = i + 1
        End If
        
    Loop
    
    getTargetFolders = folders

End Function

参考: Dir関数で全サブフォルダの全ファイルを取得|ExcelマクロVBAサンプル集