【ファイル付き】コピペで使える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. 使い方
マクロを設定
Excelを開き、「開発」タブからVBAエディター(Alt + F11)を起動。
「挿入」→「標準モジュール」を選択。
上記コードをコピー&ペースト。
マクロを実行
「開発」タブから「マクロ」ボタンをクリック。
「SelectFolderAndListFiles」を選んで「実行」をクリック。
フォルダを選択
フォルダ選択ダイアログが表示されるので、対象フォルダを選択します。ファイル名を確認
選択したフォルダ内のファイル名が、アクティブなシートの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
ファイルは以下を使用してください
その他ご要望があれば、コメントまでお願いします
暇なときに対応します!