2023年9月6日 / 最終更新日時 : 2023年10月30日 odaneko VBA

【VBA】フォルダ配下のファイル／フォルダー一覧の取得

～簡単な自己紹介～

嫁と猫3匹と暮らすフルリモートの三十路SE
ブリッジSE的なポジションを務めることが多く、チーム運営、顧客折衝、ベンダーコントロールが得意
投資・節約・副業で資産形成中
現在の金融資産は約1,650万円、めざせアッパーマス層（資産3,000万円）

VBAで開発を行っていると、フォルダー配下のファイル一覧を取得したいことが多くあります。

また、サブフォルダーも含めてファイル一覧を取得したいこともあります。

毎回どうやるんだっけ？と忘れてしまうので、コピペできるように備忘として記事に残します。

1 ソース
- 1.1 配列の末尾に要素を追加する共通関数
2 使い方

ソース

少し長いですが、右上のバインダーのようなボタンをクリックするとコードがコピーできます。

'ファイル取得
Public Function GetFiles(ByVal path, Optional is_sub_folder = False, Optional arr)
    
    'フォルダー配下検索の場合、新規で配列を用意する
    'サブフォルダー配下検索の場合、既存の配列に追加していく
    If (IsArray(arr) = False) Then
        Dim temp()
        arr = temp
    End If
    
    '対象のパスが\で終わっていなければ、\を追加
    If (Right(path, 1) <> "") Then
        path = path & "\"
    End If
    
    '配下のファイルでループ
    current_file = Dir(path)
    Do While (current_file <> "")
        
        'ファイルを配列に追加
        Call ArrayPush(arr, path & current_file)
        
        '次のファイルへ
        current_file = Dir()
        
    Loop
    
    'サブフォルダー配下も取得する場合、再起処理でサブフォルダー内のフォルダーも取得
    If (is_sub_folder) Then
        sub_folders = GetFolders(path)
        
        'サブフォルダーの数を取得
        sub_folders_count = -1
        On Error Resume Next
        sub_folders_count = UBound(sub_folders)
        
        'サブフォルダーでループ
        If (sub_folders_count > -1) Then
            For Each sub_folder In sub_folders
                Call GetFiles(sub_folder, True, arr)
            Next
        End If
    End If
    
    GetFiles = arr
    
End Function

'フォルダー取得
Public Function GetFolders(ByVal path, Optional is_sub_folder = False, Optional arr)

    'フォルダー配下検索の場合、新規で配列を用意する
    'サブフォルダー配下検索の場合、既存の配列に追加していく
    If (IsArray(arr) = False) Then
        Dim res()
        arr = res
    End If
    
    '対象のパスが\で終わっていなければ、\を追加
    If (Right(path, 1) <> "") Then
        path = path & "\"
    End If

    Set fso = New FileSystemObject
    Set sub_folders = fso.GetFolder(path)
    
    'サブフォルダーでループ
    For Each sub_folder In sub_folders.SubFolders
        
        'サブフォルダーのフォルダー名を取得
        sub_folder_name = Replace(sub_folder, path, "")
        
        '.で始まるフォルダーはシステム系の隠しフォルダーの場合が多く、取得したい場合がほぼないため除外
        If (Left(sub_folder_name, 1) <> ".") Then
            
            '配列に追加
            Call ArrayPush(arr, sub_folder)
            
            'サブフォルダー配下も取得する場合、再起処理でサブフォルダー内のフォルダーも取得
            If (is_sub_folder) Then
                Call GetFolders(sub_folder, True, arr)
            End If
        End If
    Next
    
    '後処理
    Set fso = Nothing
    
    GetFolders = arr

End Function

配列の末尾に要素を追加する共通関数

上記の処理ではファイルやフォルダーを配列にどんどん追加するのですが、配列の末尾に追加する関数はVBAには存在しません。

ないと不便なので、上記と合わせて配列末尾に要素を追加する関数を用意します。

'配列の末尾に要素を追加
Public Function ArrayPush(arr, val)
    '更新する配列の長さを取得（デフォルト:0）
    arr_length = 0
    On Error Resume Next
    arr_length = UBound(arr) + 1
    
    '配列の長さ更新
    ReDim Preserve arr(arr_length)
    
    '末尾に要素を追加
    arr(arr_length) = val
End Function

詳細は下記の記事をご覧ください。

【VBA】配列の使い方まとめ

使い方

以下のようなフォルダ・ファイル構成で実行してみます。

C:\ODANEKO\VBA
│ file1.txt
│ file2.txt
│
├─サブフォルダー1
│ │ file3.txt
│ │
│ └─サブフォルダー3
└─サブフォルダー2

ファイル一覧を取得する

下記のように呼び出します。

Private Function test()
    
    'ファイル一覧取得
    res = GetFiles("C:\odaneko\vba")
    
End Function

取得結果は下記のとおりです。

ファイル一覧を取得する（サブフォルダー配下も含む）

下記のように呼び出します。

第2引数にTrueを指定します。

Private Function test()

    'ファイル一覧取得（サブフォルダー配下も含む）
    res = GetFiles("C:\odaneko\vba", True)
    
End Function

取得結果は下記のとおりです。

フォルダー一覧を取得する

下記のように呼び出します。

Private Function test()
    
    'フォルダー一覧取得
    res = GetFolders("C:\odaneko\vba")
    
End Function

取得結果は下記のとおりです。

フォルダー一覧を取得する（サブフォルダー配下も含む）

下記のように呼び出します。

第2引数にTrueを指定します。

Private Function test()
    
    'フォルダー一覧取得（サブフォルダー配下も含む）
    folders_under_path_with_sub_folders = GetFolders("C:\odaneko\vba", True)
    
End Function