【VBA】指定したフォルダーのサブフォルダーも含むファイルの一覧を配列で取得する方法

以下で指定したフォルダーのサブフォルダーも含むファイルの一覧を取得する方法をご紹介しました。

上記の方法は取得したファイルをその都度処理するのに適した形となっています。今回はそうではなく、ファイルの一覧を取得し、その後その一覧に対して一気に処理するために、ファイルの一覧を配列で取得する方法をご紹介します。

なんでこんなにファイルの一覧取得を連発でご紹介しているかというと、「どうやるの?」と後輩から質問があるためです・・・

指定したフォルダーのサブフォルダーも含むファイルの一覧を配列で取得する方法

早速コードを提示します。

Option Explicit

' GetFileListプロシージャから、実際にファイルの一覧を取得する
' GetFileListInFolderプロシージャを呼び出す
Sub GetFileList()
    Const folderPath As String = "C:\Windows"
    
    Dim fileList() As Variant '①格納するファイル一覧の配列を定義
    ReDim fileList(0)         '②fileListの初期化
    Call GetFileListInFolder(folderPath, True, fileList) '③ ファイルのリストを取得
    ReDim Preserve fileList(UBound(fileList) - 1) '③ 最後の余計な空の要素を削除
    
    Dim msg As String
    Dim i As Long
    For i = LBound(fileList) To UBound(fileList)
        msg = msg + fileList(i) + vbCrLf
    Next i
    MsgBox (msg)
End Sub

' ファイルの一覧を出力する
' folderPath:ファイルの一覧を取得したいフォルダーのパスの文字列
' isSubFolder:サブフォルダーも対象に一覧出力したい場合はTrue、そうでなければ、False
' fileList:ファイル一覧の格納する変数
Sub GetFileListInFolder(folderPath, isSubFolder, fileList)
    
    Dim fso As FileSystemObject '④ FileSystemObject オブジェクト変数の宣言
    Dim folderObj As Folder     '⑤ Folder オブジェクト変数の宣言
    Dim fileObj As File         '⑥ File オブジェクト変数の宣言

    Set fso = New FileSystemObject             '⑦ FileSystemObjectの割り当て
    
    If Not (fso.FolderExists(folderPath)) Then '⑧ フォルダーが見つからなかったら処理を中断
        Set fso = Nothing
        MsgBox ("フォルダーが見つかりません。処理を中断します。" & vbCrLf & _
        "フォルダー:" & folderPath)
        Exit Sub
    End If
    
    If isSubFolder Then  '⑨ 引数isSubFolderがTrueだった場合、GetFileListInFolderを再帰的呼び出し。
        For Each folderObj In fso.GetFolder(folderPath).SubFolders
            Call GetFileListInFolder(folderObj.Path, isSubFolder, fileList)
        Next
    End If
    
    Set folderObj = fso.GetFolder(folderPath)  '⑩ 変数folderPathのフォルダーの取得

    For Each fileObj In folderObj.Files  '⑪ フォルダー内にある複数のファイルに対して繰り返す
        fileList(UBound(fileList)) = fileObj.Path     '⑫ 配列fileListの最後の要素にファイルのパスを格納
        ReDim Preserve fileList(UBound(fileList) + 1) ' ⑬ 配列fileListを1つ拡張
    Next

    Set fso = Nothing '⑭ fsoの破棄

End Sub

コメント

タイトルとURLをコピーしました