見出し画像

【ファイル付き】コピペで使えるExcelマクロ!フォルダ内のファイル一覧を自動取得するマクロの使い方

Excelを日常業務で活用している方にとって、フォルダ内のファイル名を手作業でリスト化するのは時間がかかる作業です。この作業を効率化するのが、**Excel VBA(マクロ)**を使った自動化です。

この記事では、フォルダ内のファイル名を簡単にExcelシートに一覧化するマクロを紹介します。初心者でも簡単に使えるように手順をわかりやすく解説します。
Excelマクロの基本的な使い方は、下の記事を参考にしてください


1. マクロの概要

このマクロでは、以下の機能を実現します:

  • フォルダ選択ダイアログを表示して、対象フォルダを選択。

  • 選択したフォルダ内のすべてのファイル名を取得。

  • ファイル名をExcelシートのA列に一覧として出力。

主な用途

  • フォルダ内のファイル名を一覧化して資料として活用。

  • ファイル管理を効率化。

  • ファイルの重複確認や整理に活用。

2. コードの説明

以下が実際に使用するコードです。このマクロを使うことで、対象フォルダを簡単に指定してファイル名を一覧化できます。
このコードをコピーして、標準モジュールに貼り付けるだけで使用可能です。
コードをどうやって貼り付けて使用していいかわからない方は、この記事の上部に、Excelマクロの基本操作の記事のリンクを貼っているためそちらを参照してください。

Sub SelectFolderAndListFiles()
    Dim folderDialog As FileDialog
    Dim selectedFolderPath As String
    Dim fileSystemObject As Object
    Dim folder As Object
    Dim file As Object
    Dim lastRow As Long
    Dim ws As Worksheet
    
    ' アクティブなシートを設定
    Set ws = ThisWorkbook.ActiveSheet
    
    ' フォルダ選択ダイアログを表示
    Set folderDialog = Application.FileDialog(msoFileDialogFolderPicker)
    With folderDialog
        .Title = "フォルダを選択してください"
        .AllowMultiSelect = False
        If .Show = -1 Then
            selectedFolderPath = .SelectedItems(1)
        Else
            MsgBox "フォルダが選択されませんでした。", vbExclamation
            Exit Sub
        End If
    End With
    
    ' ファイルシステムオブジェクトを使用してファイルを取得
    Set fileSystemObject = CreateObject("Scripting.FileSystemObject")
    Set folder = fileSystemObject.GetFolder(selectedFolderPath)
    
    ' A列の最後の空白行を取得
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row + 1
    
    ' ファイル名をシートに出力
    For Each file In folder.Files
        ws.Cells(lastRow, 1).Value = file.Name
        lastRow = lastRow + 1
    Next file
    
    MsgBox "フォルダ内のファイル名を取得しました。", vbInformation
End Sub

3. 使い方

  1. マクロを設定

    1. Excelを開き、「開発」タブからVBAエディター(Alt + F11)を起動。

    2. 「挿入」→「標準モジュール」を選択。

    3. 上記コードをコピー&ペースト。

  2. マクロを実行

    1. 「開発」タブから「マクロ」ボタンをクリック。

    2. 「SelectFolderAndListFiles」を選んで「実行」をクリック。

  3. フォルダを選択
    フォルダ選択ダイアログが表示されるので、対象フォルダを選択します。

  4. ファイル名を確認
    選択したフォルダ内のファイル名が、アクティブなシートのA列に一覧化されます。

ボタンをクリックする

フォルダを選択する(ファイルは表示されません)

ファイル名がA列に表示されます


4. ファイルの配布

実際のファイルも置いておきます。これをダウンロードして使用することも可能です。

5. まとめ

このマクロを活用することで、面倒なファイル名のリスト化作業を簡単に自動化できます。ぜひ、日々の業務効率化にお役立てください!

この記事で紹介したマクロをさらにカスタマイズしたい場合や、エラーが発生する場合は、お気軽にコメントをお寄せください!

※本記事で紹介しているマクロやファイルの使用に伴い発生したいかなるトラブルや損害についても、当方では一切の責任を負いかねます。すべて自己責任のもとでご利用ください。


追加 フォルダの中のサブフォルダを含むすべてのファイル名を一括で抽出するマクロ

上記のマクロでは、1つのフォルダ内のファイル名しか抽出できないため、複数のフォルダに分かれている場合は、フォルダごとにマクロを複数回起動する必要があります。
フォルダの中のサブフォルダまで全て1度に一括でファイル名を取得したい場合は以下のコードをご使用ください。

Sub SelectFolderAndListAllFiles()
    Dim folderDialog As FileDialog
    Dim selectedFolderPath As String
    Dim fileSystemObject As Object
    Dim folder As Object
    Dim ws As Worksheet
    Dim lastRow As Long
    
    ' アクティブなシートを設定
    Set ws = ThisWorkbook.ActiveSheet
    
    ' フォルダ選択ダイアログを表示
    Set folderDialog = Application.FileDialog(msoFileDialogFolderPicker)
    With folderDialog
        .Title = "フォルダを選択してください"
        .AllowMultiSelect = False
        If .Show = -1 Then
            selectedFolderPath = .SelectedItems(1)
        Else
            MsgBox "フォルダが選択されませんでした。", vbExclamation
            Exit Sub
        End If
    End With
    
    ' ファイルシステムオブジェクトを使用してファイルを取得
    Set fileSystemObject = CreateObject("Scripting.FileSystemObject")
    Set folder = fileSystemObject.GetFolder(selectedFolderPath)
    
    ' A列の最後の空白行を取得
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row + 1
    
    ' サブフォルダを含むすべてのファイル名をリストアップ
    Call ListFilesRecursive(folder, ws, lastRow)
    
    MsgBox "フォルダ内およびサブフォルダ内のすべてのファイル名を取得しました。", vbInformation
End Sub

Sub ListFilesRecursive(targetFolder As Object, ws As Worksheet, ByRef lastRow As Long)
    Dim file As Object
    Dim subFolder As Object
    
    ' フォルダ内のすべてのファイル名をリストアップ
    For Each file In targetFolder.Files
        ws.Cells(lastRow, 1).Value = file.Name ' ファイル名のみ
        lastRow = lastRow + 1
    Next file
    
    ' サブフォルダを再帰的に処理
    For Each subFolder In targetFolder.SubFolders
        Call ListFilesRecursive(subFolder, ws, lastRow)
    Next subFolder
End Sub

追加のカスタマイズ要望やエラーが発生する場合は、お気軽にコメントをお寄せください!

実際のファイル


追加 ファイル情報一括で取得するマクロ

コメントをいただいたので、追加させていただきました。
ファイル名の他に、以下の情報も併せて取得できるように修正しています
取得できる情報は以下になります。

  • フォルダパス

  • ファイル名

  • 作成者

  • 作成日

  • 最終更新日

  • 分類

  • ファイルサイズ


コードはこちらになります。

Sub SelectFolderAndListAllFiles()
    Dim folderDialog As FileDialog
    Dim selectedFolderPath As String
    Dim fileSystemObject As Object
    Dim folder As Object
    Dim ws As Worksheet
    Dim lastRow As Long

    ' アクティブなシートを設定
    Set ws = ThisWorkbook.ActiveSheet

    ' フォルダ選択ダイアログを表示
    Set folderDialog = Application.FileDialog(msoFileDialogFolderPicker)
    With folderDialog
        .Title = "フォルダを選択してください"
        .AllowMultiSelect = False
        If .Show = -1 Then
            selectedFolderPath = .SelectedItems(1)
        Else
            MsgBox "フォルダが選択されませんでした。", vbExclamation
            Exit Sub
        End If
    End With

    ' ファイルシステムオブジェクトを使用してファイルを取得
    Set fileSystemObject = CreateObject("Scripting.FileSystemObject")
    Set folder = fileSystemObject.GetFolder(selectedFolderPath)

    ' A列の最後の空白行を取得
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row + 1

    ' サブフォルダを含むすべてのファイル情報をリストアップ
    Call ListFilesRecursive(folder, ws, lastRow)

    MsgBox "フォルダ内およびサブフォルダ内のすべてのファイル情報を取得しました。", vbInformation
End Sub

Sub ListFilesRecursive(targetFolder As Object, ws As Worksheet, ByRef lastRow As Long)
    Dim file As Object
    Dim subFolder As Object
    Dim shellApp As Object
    Dim folderNamespace As Object
    Dim fileItem As Object

    ' Shellオブジェクトの作成
    Set shellApp = CreateObject("Shell.Application")
    Set folderNamespace = shellApp.Namespace(targetFolder.Path)

    ' フォルダ内のすべてのファイルの情報をリストアップ
    For Each file In targetFolder.Files
        Set fileItem = folderNamespace.ParseName(file.Name)

        If Not fileItem Is Nothing Then
            ' 各列に情報を設定
            ws.Cells(lastRow, 1).Value = targetFolder.Path ' フォルダパス
            ws.Cells(lastRow, 2).Value = file.Name ' ファイル名
            ws.Cells(lastRow, 3).Value = folderNamespace.GetDetailsOf(fileItem, 20) ' 作成者
            ws.Cells(lastRow, 4).Value = folderNamespace.GetDetailsOf(fileItem, 4) ' 作成日
            ws.Cells(lastRow, 5).Value = folderNamespace.GetDetailsOf(fileItem, 3) ' 最終更新日
            ws.Cells(lastRow, 6).Value = folderNamespace.GetDetailsOf(fileItem, 11) ' 分類
            ws.Cells(lastRow, 7).Value = folderNamespace.GetDetailsOf(fileItem, 1) ' ファイルサイズ
            lastRow = lastRow + 1
        End If
    Next file

    ' サブフォルダを再帰的に処理
    For Each subFolder In targetFolder.SubFolders
        Call ListFilesRecursive(subFolder, ws, lastRow)
    Next subFolder
End Sub


ファイルは以下を使用してください

その他ご要望があれば、コメントまでお願いします
暇なときに対応します!

いいなと思ったら応援しよう!