【エクセルVBA】フォルダ配下（サブフォルダ含む）の全てのファイル一覧を取得する（Collectionに詰めて返却するFunctionプロシージャ）

2022.06.03

Dir関数を使ってフォルダ直下のファイル一覧は取得できたけど、サブフォルダのファイルは取れないのかぁ。
サブフォルダのファイルも含めて取得したいのだけど。

サブフォルダも含めるなら、再帰的な取得方法にしないとだね。

へー、そうなんですね。

では、その再帰的な方法にしたいのですが、どうしたらいいのやら。。

それじゃあついでに、「Dir関数」じゃなくて「FileSystemObject」を使った方が直感的でシンプルに実装できるから、そっちに変えた方がいいかもね。

それ、ぜひ教えてほしいです。

それから、ファイルを開いて編集して保存して閉じる、という処理も実施したいのですが、「ファイル一覧取得」と「編集処理」の実装箇所をできれば分けたいんですよね。

一緒にすると煩雑になってしまいそうで。

「編集処理」をサブプロシージャにして呼び出す形にしてもいいのですが、他にいい方法ないものかなと。

それなら取得したファイルを「Collection」に詰めて返却するFunctionプロシージャにしたらいいかもね。

ということで、

フォルダ配下（サブフォルダ含む）の全ファイルの一覧をCollectionで返却するFunctionプロシージャ

を作成します。

はじめに

フォルダ配下（サブフォルダ含む）のファイル一覧を取得する方法の一つとして、FileSystemObjectを使用して再帰的に取得する方法があります。

この方法はVBA系のいくつものサイトで紹介されていて、私もこれに倣い実装していました。

ですが、

  • 「ファイル一覧取得」の実装箇所と、取得したファイルに対する「やりたい処理」の実装箇所が同じ場所になってしまい、コードが煩雑になりがち（処理の分割ができていない）
  • 「ファイル一覧取得」を他のマクロでする場合、同じ実装を新たに書かなければならない（再利用できない）

ということが気になっていました。

そこで、これらの点を解消するためFunctionプロシージャにしてみました。

ソースコード

'----------------------------------------------------------------------------------------
'指定されたフォルダ配下（サブフォルダ含む）のファイルパスを取得し、コレクションに格納して返却する
'----------------------------------------------------------------------------------------
Public Function GetFilePathsUnderFolder(ByVal folderPath As String, Optional ByRef filePaths As Collection) As Collection

    'ファイルパスを格納するコレクションが引数に指定されていない場合、コレクションを生成する
    '（再帰呼び出しされた際に毎回Newしてしまうと、ファイルパスを格納済みのコレクションへの参照が切れてしまうため）
    If filePaths Is Nothing Then
        Set filePaths = New Collection
    End If

    '引数に指定された「folderPath」内のサブフォルダを取得し、各サブフォルダのパスを引数として再帰呼び出しする
    Dim subFolder As Variant
    For Each subFolder In CreateObject("Scripting.FileSystemObject").GetFolder(folderPath).SubFolders
        Call GetFilePathsUnderFolder(subFolder.Path, filePaths)
    Next subFolder

    '引数に指定された「folderPath」内のファイルを取得し、各ファイルのパスをコレクションに格納する
    Dim oneFile As Variant
    For Each oneFile In CreateObject("Scripting.FileSystemObject").GetFolder(folderPath).Files
        filePaths.Add oneFile.Path
    Next oneFile

    'ファイルパスが格納されたコレクションを返却する
    Set GetFilePathsUnderFolder = filePaths
End Function

テストコード

フォルダを指定して上記のFunctionプロシージャを呼び出し、返却値のCollectionをFor Eachで回して、イミディエイトウィンドウに表示させます。

Sub Test()
    Dim filePath As Variant
    For Each filePath In GetFilePathsUnderFolder("C:\00_myenv\10_macro\01_test\テスト用フォルダ構成")
        Debug.Print filePath
    Next filePath
End Sub

テストデータ

テスト用のフォルダ、ファイル群は、以下のような構成にしました。

C:\00_MYENV\10_MACRO\01_TEST\テスト用フォルダ構成
                                            ├─Book (01).xlsx
                                            ├─Book (02).xlsx
                                            ├─100
                                            │  ├─Book (03).xlsx
                                            │  ├─Book (04).xlsx
                                            │  ├─101
                                            │  │  └─Book (05).xlsx
                                            │  └─102
                                            │     ├─Book (06).xlsx
                                            │     └─Book (07).xlsx
                                            └─200
                                               ├─Book (08).xlsx
                                               ├─Book (09).xlsx
                                               ├─201
                                               │  └─Book (10).xlsx
                                               └─202
                                                  ├─Book (11).xlsx
                                                  └─Book (12).xlsx

実行結果

ファイルのみフルパスで12個取得できています。

実行結果

説明

ソースコードの説明はコメントの通りです。

少し本筋からずれてしまうかもしれませんが、ここではFunctionプロシージャにした経緯についてお話しようと思います。

まず、FileSystemObjectを使って再帰的にファイル一覧を取得し、さらにそのファイルを使って何かしらの「やりたい処理」をする場合、通常、以下のような実装になるかと思います。

※「やりたい処理」は「ファイルを開いて編集して保存して閉じる」とします。

※もちろん、書き方には個人差があるので、あくまで私の場合はこんな感じというものです。

'メイン処理
Sub Main_1()
    Application.ScreenUpdating = False
    '-------------- 何かの処理 --------------

    '「ファイル一覧取得」
    Call GetFilePathsUnderFolder_1("C:\00_myenv\10_macro\01_test\テスト用フォルダ構成")

    '-------------- 何かの処理 --------------
    Application.ScreenUpdating = True
End Sub

'「ファイル一覧取得」
Sub GetFilePathsUnderFolder_1(ByVal folderPath As String)
    Dim subFolder As Variant
    For Each subFolder In CreateObject("Scripting.FileSystemObject").GetFolder(folderPath).SubFolders
        Call GetFilePathsUnderFolder_1(subFolder.Path)
    Next subFolder
    Dim oneFile As Variant
    For Each oneFile In CreateObject("Scripting.FileSystemObject").GetFolder(folderPath).Files

        '「やりたい処理」（ファイルを開いて編集して保存して閉じる）
        With Workbooks.Open(oneFile.Path)
            .Worksheets("Sheet1").Range("A1") = "編集済み"
            .Save
            .Close
        End With

    Next oneFile
End Sub

このように、

「ファイル一覧取得」をしつつ、1ファイル取得したら、それに対して「やりたい処理」も実施する

という感じになります。

この実装で、実行結果としては何ら問題はありません。

ですが、「はじめに」のところでも触れましたが、個人的に以下の点が気になっていました。

  1. 「ファイル一覧取得」と「やりたい処理」が同じ箇所に実装されている。
    →ある処理の中に別の処理が混ざっており、プログラミング的に「処理の分割」ができていない。
    また、上のコードでは「やりたい処理」部分が短いが、ここが10行以上にもなると煩雑さが増してくる。
  2. 他のマクロで「ファイル一覧取得」をしたくなったら、また同じ実装を書かなければいけない。
    →「ファイル一覧取得」という汎用性の高い処理にもかかわらず「再利用」ができない。

ということで、上記2点を解消できないか考えてみます。

まずは、1点目の「処理の分割ができていない」の解決方法として、

「やりたい処理」をサブプロシージャにして呼び出す

というように、実装を変えてみます。

'メイン処理
Sub Main_2()
    Application.ScreenUpdating = False
    '-------------- 何かの処理 --------------

    '「ファイル一覧取得」
    Call GetFilePathsUnderFolder_2("C:\00_myenv\10_macro\01_test\テスト用フォルダ構成")

    '-------------- 何かの処理 --------------
    Application.ScreenUpdating = True
End Sub

'「ファイル一覧取得」
Sub GetFilePathsUnderFolder_2(ByVal folderPath As String)
    Dim subFolder As Variant
    For Each subFolder In CreateObject("Scripting.FileSystemObject").GetFolder(folderPath).SubFolders
        Call GetFilePathsUnderFolder_2(subFolder.Path)
    Next subFolder

    Dim oneFile As Variant
    For Each oneFile In CreateObject("Scripting.FileSystemObject").GetFolder(folderPath).Files
        '「やりたい処理」の呼び出し
        Call EditFiles_2(oneFile.Path)
    Next oneFile
End Sub

'「やりたい処理」（ファイルを開いて編集して保存して閉じる）
Sub EditFiles_2(ByVal filePath As String)
    With Workbooks.Open(filePath)
        .Worksheets("Sheet1").Range("A1") = "編集済み"
        .Save
        .Close
    End With
End Sub

1ファイル取得するごとに「やりたい処理」を呼び出してはいますが、実行結果は同じままで、「ファイル一覧取得」と「やりたい処理」を分割できました。

また、「やりたい処理」の実装が長くなっても、変更前の実装と比べれば、その煩雑さは大分軽減できます。

つぎに、2点目の「再利用ができない」を解決するため、

「ファイル一覧取得」を汎用的なFunctionプロシージャにする

という変更をしてみます。

'メイン処理
Sub Main_3()
    Application.ScreenUpdating = False
    '-------------- 何かの処理 --------------

    '「ファイル一覧取得」
    Dim filePaths As Collection
    Set filePaths = GetFilePathsUnderFolder_3("C:\00_myenv\10_macro\01_test\テスト用フォルダ構成")

    '「やりたい処理」
    Call EditFiles_3(filePaths)

    '-------------- 何かの処理 --------------
    Application.ScreenUpdating = True
End Sub

'「ファイル一覧取得」（Functionプロシージャに変更）
Public Function GetFilePathsUnderFolder_3(ByVal folderPath As String, Optional ByRef filePaths As Collection) As Collection
    If filePaths Is Nothing Then
        Set filePaths = New Collection
    End If
    Dim subFolder As Variant
    For Each subFolder In CreateObject("Scripting.FileSystemObject").GetFolder(folderPath).SubFolders
        Call GetFilePathsUnderFolder_3(subFolder.Path, filePaths)
    Next subFolder
    Dim oneFile As Variant
    For Each oneFile In CreateObject("Scripting.FileSystemObject").GetFolder(folderPath).Files
        filePaths.Add oneFile.Path
    Next oneFile
    Set GetFilePathsUnderFolder_3 = filePaths
End Function

'「やりたい処理」（ファイルを開いて編集して保存して閉じる）
Sub EditFiles_3(ByVal filePaths As Collection)
    Dim filePath As Variant
    For Each filePath In filePaths
        With Workbooks.Open(filePath)
            .Worksheets("Sheet1").Range("A1") = "編集済み"
            .Save
            .Close
        End With
    Next filePath
End Sub

汎用的なFunctionプロシージャにすることで、「ファイル一覧取得」の処理は他のマクロからも呼び出せるようになりました。

その結果、メイン処理の流れが、

何かの処理　→　ファイル一覧取得　→　やりたい処理　→　何かの処理

となり、全体としてどういう処理をしているのか、ここを見ただけで分かりやすくもなっています。

まとめ

フォルダ配下（サブフォルダ含む）にある全てのファイル一覧の取得について、FileSystemObjectを使った再帰的な取得方法を用い、さらにファイル一覧をCollectionに詰めて返却する、というFunctionプロシージャの紹介でした。

こうすることで、従来の実装よりソースコードが見やすくなり、「ファイル一覧取得」の再利用もできるようになりました。

以上、ご覧いただきありがとうございました。