【VBA】フォルダ内のフォルダ一覧を取得する（サブフォルダ内を含む） | あじゅWeb

【VBA】フォルダ内のフォルダ一覧を取得する（サブフォルダ内を含む）

2019.07.01

エクセルVBAで使うコードの備忘録。VBAで指定フォルダ内のすべてのサブフォルダのパスを取得するコード。サブフォルダ内に含まれるすべてのフォルダもすべて網羅的に取得できるようにしています。サブフォルダ内のフォルダを含まない方法についてはこちらのご覧ください。サンプルコードのみが必要な場合は一番最後にありますので、説明は必要に応じて見てみてください。

スポンサーリンク

指定フォルダ内にある一次のサブフォルダを返す

サブフォルダ内も含めて含まれるすべてのフォルダを取得する方針は、「指定フォルダ内のサブフォルダを全て取得する関数を作り、取得されたサブフォルダすべてに対して再度その関数を使ってさらに下部にあるフォルダを探しに行く」という感じになります。わかりにくいですが、まず必要になるのは、指定フォルダ内にある一次のサブフォルダを返す関数です。

下記は、ファイルシステムオブジェクトを利用して、関数に引数として渡されたフォルダパス内にある一次のサブフォルダを取得して返す関数です。

Public Function GetFolderPath(folderPath As String) As String()
    
    '--- ファイルシステムオブジェクト ---'
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    '--- フォルダ数を格納する変数 ---'
    Dim n As Variant
    n = fso.GetFolder(folderPath).SubFolders.Count
    
    '--- フォルダ名を格納する配列 ---'
    Dim str() As String
    ReDim str(1 To n)
    
    '--- フォルダ名を格納 ---'
    Dim i As Long
    i = 1
    Dim f As Object
    For Each f In fso.GetFolder(folderPath).SubFolders
        str(i) = f.Path
        i = i + 1
    Next f
    
    GetFolderPath = str
    
End Function

関数を再帰的に呼び出す

一次のサブフォルダを取得する関数を再帰的に呼び出すことですべての下部フォルダを取得できるようにします。具体的には下記を参考にしてみてください。上で説明した一次サブフォルダを取得する関数を再帰的に呼び出して結果を結合して返せるように変更しています（思った以上に変更店が多くて上のコードと比較するのは難しいかもしれません）。

なお、再帰的に関数を呼び出して結果を配列に結合する際に、配列が空でないかを判定する関数を自作して使用しています（詳細はこちら）。再帰的に呼び出していると、どこかでそれ以上深いフォルダはないという段階に達しますが、その状態を判定するのに使用しています。

なお、サンプルコードを使用する際はカッコに囲まれた部分（[***]）を自分のプログラムに合わせて変更してください。

サンプルコード

'--- サブフォルダのパス一覧を配列に取得する ---'
Public Sub GetAllSubFolderPath()

    '--- フォルダ一覧を取得したいフォルダのパス ---'
    Dim folderPath As String
    folderPath = "[フォルダパス]"
    
    '--- フォルダパスを取得する ---
    Dim folderList As Variant
    folderList = GetFolderPath(folderPath)
    
End Sub

'--- サブフォルダを再帰的に取得する関数 ---'
Public Function GetFolderPath(folderPath As String) As String()
    
    '--- ファイルシステムオブジェクト ---'
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    '--- フォルダ数を格納する変数 ---'
    Dim n As Variant
    n = fso.GetFolder(folderPath).SubFolders.Count
    
    If (0 < n) Then
        '--- フォルダパスを格納する配列 ---'
        Dim str() As String
        ReDim str(1 To n)
        
        '--- フォルダパスを格納 ---'
        Dim i As Long
        Dim j As Long
        Dim m As Long
        i = 1
        Dim strTmp() As String
        
        'フォルダパスを指定してすべてのサブフォルダを取得
        Dim f As Object
        For Each f In fso.GetFolder(folderPath).SubFolders
            str(i) = f.Path
            
            strTmp = GetFolderPath(str(i))  '再帰的呼び出し
            If (Not IsEmptyArray(strTmp)) Then
                m = UBound(strTmp, 1)
            Else
                m = 0
            End If
            
            'サブフォルダ内にさらにフォルダがあればその分だけ配列を拡張
            n = UBound(str, 1)
            ReDim Preserve str(1 To n + m)
            For j = 1 To m
                str(i + j) = strTmp(j)
            Next j
            
            i = i + m + 1
        Next f
    End If
    
    GetFolderPath = str
    
End Function

'--- 配列が空かどうかを判定する関数 ---'
Public Function IsEmptyArray(arrayTmp As Variant) As Boolean
On Error GoTo ERROR_

    If (0 < UBound(arrayTmp, 1)) Then
        IsEmptyArray = False
    End If
    
    Exit Function

ERROR_:
    
    IsEmptyArray = True
    
End Function
スポンサーリンク