【ツールDL可】Excel VBAでフォルダ内のファイル名とパス一覧を取得する

フォルダにあるファイル名やパスをExcelへまとめる作業はないでしょうか。

特にファイルがたくさんあったり、フォルダが何階層もあったりすると手間ですよね。

そこで今回はそのようなときに一発でフォルダ名とそのパスを取得し、Excelシートへ出力する方法をご紹介したいと思います。

サンプルの準備をする

今回のサンプルは適当なディレクトリにテストフォルダを4階層作成し、各フォルダごとに2ファイルづつ格納しています。

次に新規作成したExcelシートを開き、C1へ上記フォルダのパスを入力し、D1へ1か2を入力します。サブフォルダを含める場合は2、含めない場合は1を指定してください。

これで準備は完了です！
ではさっそくやってみましょう。

VBAを実装する

続いてVBAを実装します。

今回VBAは以下の通りとなります。

Sub ファイル名取得起動()
    Dim cnt As Long
    Dim Subfolder As Long
    Dim strPath As String
    
    'ファイル名出力開始の行指定
    cnt = 2
    
    'サブフォルダ対象要否フラグ取得　含める：２　含めない：１
    Subfolder = Cells(1, 4)
    
    '抽出対象パスを取得
    strPath = Cells(1, 3)
    
    ' 一旦、シート保護を解除
     'ActiveSheet.Unprotect
    
    'A～D列値のみクリア
    Range("A:B").ClearContents

    ' ファイル名取得呼び出し
    Call ファイル名取得(strPath, cnt, Subfolder)
    MsgBox cnt - 2 & "件取得しました。"
End Sub


 
Sub ファイル名取得(strPath As String, cnt As Long, Subfolder As Long)

    Dim objFolder As Object
    Dim objSubfolder As Object
    Dim Maxoutput As Long
    
    '出力件数最大値指定
    Maxoutput = 65000
     
    'エラー停止を無効化
    On Error Resume Next

    
    With CreateObject("Scripting.FileSystemObject")
    
        'パス入力がある場合に処理開始
        If strPath = "" Then
            MsgBox "ファイル格納フォルダのパスを入力してください。"
        Else

        'フォルダ内のファイル名、パス取得
            For Each objFolder In .GetFolder(strPath).Files
                cnt = cnt + 1
                Cells(cnt, 1) = objFolder.Name
                Cells(cnt, 2) = objFolder.Path
                 
                If cnt > Maxoutput Then
                     MsgBox Maxoutput & "件を超えましたので終了します。"
                    Exit For
                End If
            Next objFolder


        'サブフォルダ内のファイル名、パス取得
            If Subfolder = 2 Then
            For Each objSubfolder In .GetFolder(strPath).Subfolders
             
                If objSubfolder.Name <> "" Then
                    cnt = cnt + 1
                    Cells(cnt, 1) = objSubfolder.Name
                    Cells(cnt, 2) = objSubfolder.Path
                    Call ファイル名取得(objSubfolder.Path, cnt, Subfolder)

                Else
                    Exit For
                End If
                 
                If cnt > Maxoutput Then
                    MsgBox Maxoutput & "件を超えましたので終了します。"
                    Exit For
                End If
            Next objSubfolder
            End If
        End If
        
    End With
End Sub

実装手順は以下の通りです。今回はExcel側にこのVBAを実装します。
①Excelを新規に開き、「開発」タブをクリックし、「VisualBasic」をクリックします。
もしくはショートカットキー「Alt」＋「F11」でもOKです。