はじめに
Excel でカウントディレクトリのファイルに加えてサブディレクトリに含まれるファイルの一覧を出力するマクロの作成方法についてご紹介します。
ちょっと専門用語が多かったような気もするので、
要するにあるフォルダ内にフォルダの中のファイルも全部含めてファイル一覧させる方法についてご紹介します。
今回は Excel Vba を使います。
自分でつくってみてだいたい１～２時間くらいでできましたが、結構簡単なのでぜひ興味のある方は参考にしてみてください。
※実際に作成したマクロは下記からダウンロードできますので、興味のある方はぜひダウンロードしてみてください。
作成方法
ご紹介します Excel マクロは大きく二つの機能から構成されています。
- ファイル一覧を出力するパスを取得
- 取得したパスからファイル一覧を出力
ファイル一覧を出力するパスを取得
ファイル一覧を表示させるためのファイルパスを取得するための機能をご紹介します。
下記画面のように「フォルダパス取得」ボタンを押下することで、ファイル一覧を表示させるためのファイルパス（下画面なら「C:\test」)を表示させます。
下記にソースコードを記載します。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 |
Option Explicit Const X As Integer = 1 Const Y As Integer = 8 Const CELL_FILE_PATH As String = "B3" Const ERRORMESSAGE As String = "フォルダ一覧を出力するための正しいパスを入力ください。" Const COMPLETEMSG As String = "処理が完了しました。" ' ファイルパス取得 Sub getFilePath() With Application.FileDialog(msoFileDialogFolderPicker) If .Show = True Then Range(CELL_FILE_PATH).Value = .SelectedItems(1) End If End With End Sub ' メイン Sub getFileList() Dim start_x As Long: start_x = X Dim start_y As Long: start_y = Y Dim searchFolderPath As String Dim checkFolderPath Application.ScreenUpdating = False On Error Resume Next searchFolderPath = Range(CELL_FILE_PATH).Value ' ファイルの存在チェック checkFolderPath = Dir(searchFolderPath, vbDirectory) If searchFolderPath = "" Or checkFolderPath = "" Then MsgBox ERRORMESSAGE, vbCritical End End If ' シートの初期化 Call settingSheet ' ファイル一覧作成 Call printFileList(searchFolderPath, start_x, start_y) ' フォーマット整形 Call formattingSheet MsgBox COMPLETEMSG, vbInformation Application.ScreenUpdating = True End Sub ' ファイル一覧作成 Private Sub printFileList(searchFolderPath As String, ByRef start_x, ByRef start_y) Dim fso As New FileSystemObject Dim folderList As Folders Dim folderName As folder Dim fileName As File Dim str As String Dim slashNum As Long Set folderList = fso.GetFolder(searchFolderPath).SubFolders 'フォルダ内のファイル名の取得し、セルにパスとファイル名を書き込む For Each fileName In fso.GetFolder(searchFolderPath).Files slashNum = InStrRev(fileName.Path, "\") Cells(start_y, start_x).Value = Mid(fileName.Path, slashNum + 1) Cells(start_y, start_x + 1).Value = Left(fileName.Path, slashNum - 1) Cells(start_y, start_x + 2).Value = Format(fileName.Size / 1024, "0.#0000") & " バイト" Cells(start_y, start_x + 3).Value = fileName.DateCreated Cells(start_y, start_x + 4).Value = fileName.DateLastModified start_y = start_y + 1 Next ' サブフォルダ一覧取得 再帰処理 For Each folderName In folderList Call printFileList(folderName.Path, start_x, start_y) Next End Sub ' シートの初期化 Private Sub settingSheet() Dim maxCol Dim maxRow maxRow = Cells(Rows.Count, X).End(xlUp).Row maxCol = Cells(Y, Columns.Count).End(xlToLeft).Column Range(Cells(Y, X), Cells(maxRow + Y, maxCol + X)).ClearContents End Sub ' フォーマット整形 Private Sub formattingSheet() Columns("A:E").Select Columns("A:E").EntireColumn.AutoFit Range("A1").Select End Sub |
要はダイアログ画面からファイルをファイルパスを選択して、選択した値をB3セルに書き込むというそれだけの処理です。
取得したパスからファイル一覧を出力
これは「ファイル一覧出力」ボタンを押下することで、取得したパスのファイル一覧出力を出力させる処理です。
処理は下記の順番になります。順を追って説明していきます。
- 取得したパスが正しい値であるかを確認
- シートの初期化
- ファイル一覧作成
- シートのフォーマット整形
取得したパスが正しい値であるかを確認
ここでは取得したパスが正しいパスかどうかを確認します。
前述しました「ファイルパス取得」ボタンを押していれば間違いなく正しいパスが取得できますが、
ボタンを押し忘れたり誤って値を入力することでわけわからんパスを参照することを防ぎます。
ソースコード
|
1 2 3 4 5 6 7 8 9 10 11 12 13 |
Const ERRORMESSAGE As String = "フォルダ一覧を出力するための正しいパスを入力ください。" Dim searchFolderPath As String Dim checkFolderPath searchFolderPath = Worksheets(FOLDERPATH).Range("B3").Value ' ファイルの存在チェック checkFolderPath = Dir(searchFolderPath, vbDirectory) If searchFolderPath = "" Or checkFolderPath = "" Then MsgBox ERRORMESSAGE, vbCritical End End If |
その結果をcheckFolderPathに格納し、もし searchFolderPath か checkFolderPath の値が空の場合はエラーメッセージを表示させ処理を終了します。
シートの初期化
これは処理を行う前にシートをきれいにする処理のことです。
具体的には、ファイル一覧を出力しているセル範囲（B6以降のセル）の値のみを削除しています（書式は削除していません）。
ソースコード
|
1 2 3 4 5 6 7 8 9 10 |
Const X As Integer = 2 Const Y As Integer = 6 Dim start_x As Long: start_x = X Dim start_y As Long: start_y = Y ' シートの初期化 maxRow = Worksheets(FOLDERPATH).Cells(Rows.Count, X).End(xlUp).Row maxCol = Worksheets(FOLDERPATH).Cells(Y, Columns.Count).End(xlToLeft).Column Worksheets(FOLDERPATH).Range(Cells(Y, X), Cells(maxRow + Y, maxCol + X)).ClearContents |
ファイル一覧作成
ここではファイル一覧を取得し、それをシートに出力する処理です。
引数は、取得したパス searchFolderPath、書き込むセルの位置 start_x、 start_y の３つです。
まずはフォルダ以外のファイル名を取得し、そのファイルの情報（下記に記載します）を取得します。
下記の 変数 fileNameはフォルダ内にあるファイルを変数に格納させた値と思ってください。
- ファイル名 ※下記に記載
- ファイルのパス（ファイル名を除く） → Left(fileName.Path, slashNum - 1)
- ファイルサイズ（バイト）→ Format(fileName.Size / 1024, "0.#0") & " バイト"
- 作成日時 → fileName.DateCreated
- 更新日時 → fileName.DateLastModified
※ ファイル名の処理
まず、フォルダ内のファイルのフルパス fileName.Path とし、その fileName.Pathの後方から最初に来る「\」よりも後ろの値を取得します。
何言っているかよくわからない方もいると思いますので、もう少し具体的に説明しますと
例えばフォルダ内のファイルのフルパス fileName.Pathが以下のような値としますと、
|
1 2 3 |
slashNum = InStrRev(fileName.Path, "\") 'セルにパスとファイル名を書き込む Worksheets(FOLDERPATH).Cells(start_y, start_x).Value = Mid(fileName.Path, slashNum + 1) |
次にフォルダ内にあるサブフォルダ（サブディレクトリ）については、GetFolder関数を用いて取得します。
そして再帰処理（つまり処理を繰り返す）を行い、サブフォルダが見つからなくなくなるまで処理をくり返します。
その処理を繰り返している間も、そのフォルダに含まれるファイル名はすべて出力するようにします。
下記にソースコードを記載します。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 |
' ファイル一覧作成 Private Sub printFileList(searchFolderPath As String, ByRef start_x, ByRef start_y) Dim fso As New FileSystemObject Dim folderList As Folders Dim folderName As folder Dim fileName As File Dim str As String Dim slashNum As Long Set folderList = fso.GetFolder(searchFolderPath).SubFolders 'フォルダ内のファイル名の取得 For Each fileName In fso.GetFolder(searchFolderPath).Files slashNum = InStrRev(fileName.Path, "\") 'セルにパスとファイル名を書き込む Worksheets(FOLDERPATH).Cells(start_y, start_x).Value = Mid(fileName.Path, slashNum + 1) Worksheets(FOLDERPATH).Cells(start_y, start_x + 1).Value = Left(fileName.Path, slashNum - 1) Worksheets(FOLDERPATH).Cells(start_y, start_x + 2).Value = Format(fileName.Size / 1024, "0.#0") & " バイト" Worksheets(FOLDERPATH).Cells(start_y, start_x + 3).Value = fileName.DateCreated Worksheets(FOLDERPATH).Cells(start_y, start_x + 4).Value = fileName.DateLastModified start_y = start_y + 1 Next ' サブフォルダ一覧取得 再帰処理 For Each folderName In folderList Call printFileList(folderName.Path, start_x, start_y) Next End Sub |
最後に
いかがでしょうか？
もしつくるのめんどくせえとか実際に作ったのがそんなのか見てみたい！という人がいましたら下記ボタンからダウンロードできますので、ぜひ試してみてください。
