[ExcelVBA] 指定したフォルダ配下の全てのフォルダを調べる

>Blog Top Page >[ExcelVBA] Top Page >[ExcelVBA] プログラミング問題一覧

■お題
指定したフォルダ以下にある全てのフォルダを表示すること

■解答例
ファイルシステムオブジェクトの「オブジェクト.SubFolders」を使えばよさそうですね。
まずは、考え方です。こういう風に考えてみました。
指定フォルダに対し、「オブジェクト.SubFolders」で指定フォルダ内のサブフォルダが取得できます。
例えば、指定フォルダには１０個のフォルダがあったとします。
この情報を配列に格納しておきます。

次に、この配列に対しDoLoopで一つ一つ、サブフォルダを取得するのを繰り返せばよさそうです。
ただし、DoLoop内で新たに見つけたサブフォルダを処理の候補にいれる為共通の配列に格納する必要があります。

↑新たにみつけたものを追加。

そこで、引数の受け渡しに参照渡し(ByRef)で渡してフォルダのリストを更新し続けます。

まずは、サブフォルダの一覧を取得するテストコードを書いてみます。

Option Explicit

Sub test1()
    Dim FolderPath As String
    FolderPath = "C:\test"
    
    Dim FSO As New FileSystemObject
    Dim Folders As Folders, Folder As Folder
    Set Folders = FSO.GetFolder(FolderPath).SubFolders

    For Each Folder In Folders
        Debug.Print Folder.Path
    Next
End Sub

４行目：指定するファルダ名を格納する変数
５行目：今回は、C:\testフォルダパスを指定
７行目：ファイルシステムオブジェクトを生成
８行目：Folders型とFolder型のオブジェクトの変数を宣言
９行目：指定したフォルダ内の全てのフォルダの情報を取得
１１行目：For文で８行目で取得した全てのフォルダ情報を一つずつ渡していく
１２行目：フォルダ情報のうち、パスのプロパティをデバック表示する
１３行目：繰り返し。


これで、指定したフォルダ内にあるフォルダパスを取得できますね。
では、参照渡しで一つの配列にフォルダパスを格納するあたりを確認するコードを書いてみます。

Option Explicit

Sub test2_main()
    Dim FolderPath As String
    FolderPath = "C:\test"
    
    Dim FolderList As Variant
    FolderList = Array("FolderPass_1", "FolderPass_2", "FolderPass_3")
    Call test2_sub(FolderPath, FolderList)
    
    Dim Folder As Variant
    For Each Folder In FolderList
        Debug.Print Folder
    Next
End Sub

Sub test2_sub(ByVal FolderPath As String, ByRef FolderList As Variant)    
    Dim FSO As New FileSystemObject
    Dim Folders As Folders, Folder As Folder
    Set Folders = FSO.GetFolder(FolderPath).SubFolders
    
　　Dim i As Integer
    i = UBound(FolderList) + 1
    
    For Each Folder In Folders
        ReDim Preserve FolderList(i)
        FolderList(i) = Folder.Path
                
        i = i + 1
    Next
End Sub

- test2_main -
４行目：指定するファルダ名を格納する変数
５行目：今回は、C:\testフォルダパスを指定
７行目：フォルダパスを一括管理する用の変数です。
参照渡しでサブ関数に渡してフォルダパス情報を受け取るのに使います。
８行目：フォルダパスが追加されるか確認するために、適当に何か配列に格納しておきます。
９行目：パスと、配列を渡し、"test2_b"で第一引数のパス配下にあるフォルダ情報を格納させる。
１１行目：参照渡しで格納してもらった配列の中身をFor文で確認する為For文で使う変数を宣言
１２行目：For文で配列の一覧を確認
１３行目：デバック表示する
１４行目：繰り返し

- test2_sub -
１８行目：ファイルシステムオブジェクトを生成
１９行目：Folders型とFolder型のオブジェクトの変数を宣言
２０行目：指定したフォルダ内の全てのフォルダの情報を取得
２２行目：動的に配列を増やす際に使う変数を宣言。要素数の管理に使用。
２３行目：再宣言するために現在の配列の最後の要素数を調べる。
そして、再宣言するために１多くしとく。（注：後で問題発生します)
２５行目：For文で１９行目で取得した全てのフォルダ情報を一つずつ渡していく
２６行目：配列の要素数を再定義をする。 Preserveキーワードをつけないと今まで格納した
データが消えてしまうので、Preserveキーワードをつけておく。
２７行目：最後の要素にフォルダパスを格納する
２９行目：配列の再定義に使う変数を１つインクリメントする
３０行目：繰り返し

メモ：Uboundは、配列の一番最後の要素数を返す。

あとは、DoLoopで繰り返す部分を作れば完成ですね。

Option Explicit

Sub main()
    Dim FolderName As String, Result() As String
    FolderName = "C:\test"
    Result = GetAllFolderPath(FolderName)

    Dim f As Variant
    For Each f In Result
        Debug.Print f
    Next
End Sub

Function GetAllFolderPath(ByVal FolderName As String)
    
    Dim FolderPathList() As String, LastIndex As Integer
    LastIndex = -1
    Call GetFolderPath(FolderName, FolderPathList, LastIndex)
    If LastIndex = -1 Then
        GetAllFolderPath = Array("")
        Exit Function
    End If
    
    Dim i As Integer
    i = 0
    
    Do
        Call GetFolderPath(FolderPathList(i), FolderPathList, LastIndex)
        i = i + 1
    Loop While i < LastIndex

    GetAllFolderPath = FolderPathList
End Function

Sub GetFolderPath(ByVal FolderName As String, ByRef FolderPathList As Variant, ByRef LastIndex As Integer)
    Dim FSO As New FileSystemObject
    Dim Folders As Folders, Folder As Folder
    Set Folders = FSO.GetFolder(FolderName).SubFolders
    
    For Each Folder In Folders
        LastIndex = LastIndex + 1
        If LastIndex = 0 Then
            ReDim FolderPathList(LastIndex)
        Else
            ReDim Preserve FolderPathList(LastIndex)
        End If
        
        FolderPathList(LastIndex) = Folder.Path
    Next
End Sub

動的配列用の変数は、要素数が確定する前にUBoundを使うとエラーとなるので 使わずに、要素数を知るために、管理用に一つ変数を増やして参照渡しして管理してます。 使い方は、GetAllFolderPathに調べたいフォルダのパスを引数として渡す。 で、要素数を指定してない配列を返り値に受け取る。 以上。 ちなみに、下記フォルダ構成だと。

イミディエイトウィンドウには、こんな出力になる。

>Blog Top Page >[ExcelVBA] Top Page >[ExcelVBA] プログラミング問題一覧