再帰的にサブフォルダを検索しファイルパスを取得する

2019年6月19日2021年8月22日

GetFilePathList関数

指定フォルダとそのサブフォルダからファイルパターンに合致するファイルのパスを再帰的に取得し、リスト形式で返す関数。
※ filePathListの引数には、System.Collections.ArrayList形式のオブジェクトを指定する必要があります。詳しくは実行方法をご参照ください。
※ ShowErrorMessage関数についてはリンク先をご参照ください。

'==================================================
' <summary>
' 指定フォルダからファイルパターンに合致するファイルのパスを
' リスト形式で取得する
' </summary>
' <param name="specifiedFolder">指定フォルダ</param>
' <param name="filePattern">ファイルパターン</param>
' <param name="containsSubFolder">サブフォルダを含める</param>
' <param name="filePathList">ファイルパスリスト</param>
' <remarks>
' filePatternは、*.拡張子(例：*.txt)の形式で指定する
' filePathListは、System.Collections.ArrayList形式で指定する
' </remarks>
'==================================================
Public Sub GetFilePathList(ByVal specifiedFolder As String, _
        ByVal filePattern As String, _
        ByVal containsSubFolder As Boolean, _
        ByRef filePathList As Object)

    Dim GetFileName As String
    Dim subFolder As Object

    On Error GoTo Catch

    GetFileName = Dir(specifiedFolder &amp;amp; "\" &amp;amp; filePattern)
    Do While GetFileName <> ""
        Call filePathList.Add(specifiedFolder &amp;amp; "\" &amp;amp; GetFileName)
        GetFileName = Dir()
    Loop

    If containsSubFolder Then
        With CreateObject("Scripting.FileSystemObject")
            For Each subFolder In .GetFolder(specifiedFolder).SubFolders
                Call GetFilePathList(subFolder.path, _
                        filePattern, _
                        containsSubFolder, _
                        filePathList)
            Next subFolder
        End With
    End If

    Exit Sub

Catch:
    Call ShowErrorMessage("GetFilePathList")

End Sub

実行方法

'==================================================
' <summary>
' GetFilePathList関数のテスト
' </summary>
'==================================================
Sub TestGetFilePathList()

    Dim filePathList As Object
    Dim filePath As Variant
    Dim result As String

    Set filePathList = VBA.CreateObject("System.Collections.ArrayList")

    Call GetFilePathList("C:\Test", "*.txt", True, filePathList)

    For Each filePath In filePathList
        If result = "" Then
            result = filePath
        Else
            result = result &amp;amp; vbCrLf &amp;amp; filePath
        End If
    Next filePath

    MsgBox result

End Sub

実行結果