【本日のミッション】
Excel VBAにて指定したフォルダの全ての階層のフォルダ名・サブフォルダ名・ファイル名を取得し、一覧表を作成せよ。
以前お話ししました
指定したフォルダ内のサブフォルダのフォルダ名を全部取得(Excel VBA)
指定したフォルダ内とサブフォルダ内全てのファイル名を取得(Excel VBA)
から更に進歩です!!
ミッションの概要
- セルB3に、フォルダ・サブフォルダ・ファイル名を取得したいフォルダのパスを入力
- セルB6に、一覧表を作りたいセル範囲の左上のセルアドレスを入力
- <フォルダ・ファイル名一覧作成>ボタンをポチっと
すると、セルB6に入力したアドレスに、ファイル・フォルダ一覧表が完成です。
対象フォルダパス「C:\VBA」の中には下記フォルダ・ファイルが入っています。
完成した表は下記の通りになります。
今回の作表はこちらのサイト様を参考に作らせていただきました。
ファイルの準備とプロシージャ
Excelマクロ有効ブック(.xlsm)のファイルを新規作成します。
そのファイルのシートに下記の通り、フォルダのパスを入力するセル(B3)、取得したファイル名を書き出すセル(B6)、VBAを登録するボタンを準備します。
フォルダパス(B3)には、取得したいフォルダ・ファイルが入っているフォルダのフルパスを入力します。
Alt+F11でVsual Basic Editerを起動します。
[挿入]-[標準モジュール]で新規モジュールを作成し、下記の通りコードを記入します。
'【変数】 Dim s_row As Long '開始行 Dim s_col As Long '開始列 Dim e_col As Long '終了列 Sub 指定したフォルダ内の全階層のフォルダ名とファイル名で一覧作成() '【変数】 'ファイル・シート関連関連 Dim FSO As Object 'FileSystemObject Dim pt As String '対象フォルダパス '行列関連 Dim t_row As Long '対象行 Dim t_col As Long '対象列 Application.ScreenUpdating = False '画面表示の停止 '■変数セット s_row = Range(Range("B6")).Row '開始行 s_col = Range(Range("B6")).Column '開始行 t_row = s_row + 1 '対象行 t_col = s_col '対象列 e_col = t_col '最終列 '■FileSystemObjectのインスタンス化 Set FSO = CreateObject("Scripting.FileSystemObject") '■対象フォルダパス(最後に「\」が無ければ「\」を付ける) If Right(pt, 1) = "\" Then pt = Range("B3") Else pt = Range("B3") & "\" End If '■対象フォルダの有無の確認 If Not FSO.FolderExists(pt) Then MsgBox ("ご指定のフォルダは存在しません。") Exit Sub End If '■前回データのクリア Rows(s_row & ":" & Cells.Rows.Count).Clear '■再帰処理開始 Call フォルダファイル名取得(FSO, pt, t_row, t_col) '■列幅の調整 Range(Columns(t_col), Columns(Columns.Count)).ColumnWidth = 3 Range(Columns(e_col), Columns(e_col + 2)).EntireColumn.AutoFit '■サイズ、更新日時の罫線設定 Range(Cells(s_row, e_col + 1), Cells(t_row - 1, e_col + 1)).BorderAround Weight:=xlHairline, LineStyle:=xlContinuous Range(Cells(s_row, t_col), Cells(t_row - 1, e_col + 2)).BorderAround LineStyle:=xlContinuous '■見出し設定 Cells(s_row, s_col) = "フォルダ・ファイル名" Cells(s_row, e_col + 1) = "サイズ" Cells(s_row, e_col + 2) = "更新日時" Range(Cells(s_row, e_col + 1), Cells(s_row, e_col + 2)).HorizontalAlignment = xlCenter Application.Goto reference:=Range("A1"), scroll:=True Range(Range("B3"), Range("XFD2")).ClearFormats '■オブジェクトの解放 Set FSO = Nothing Application.ScreenUpdating = False '画面表示の再開 End Sub Sub フォルダファイル名取得(FSO As Object, pt As String, t_row As Long, t_col As Long) '【変数】 Dim s_fd As Object 'サブフォルダ Dim fl As Object 'ファイル Dim strSplit() As String '■最終列が増えた場合、サイズ列の前に1列追加 If t_col > e_col Then Columns(t_col).Insert Shift:=xlToRight e_col = t_col End If '■サブフォルダの取得 For Each s_fd In FSO.GetFolder(pt).SubFolders '変数s_fdに対象フォルダ内のサブフォルダを順に取得 '□サブフォルダ名転記 Cells(t_row, t_col) = s_fd.Name '□サブフォルダにハイパーリンクを設定 ActiveSheet.Hyperlinks.Add _ Anchor:=Cells(t_row, t_col), _ Address:=s_fd.Path, _ TextToDisplay:=s_fd.Name '□サブフォルダ名罫線設定 Call 罫線(t_row, t_col) t_row = t_row + 1 '□再帰処理 Call フォルダファイル名取得(FSO, s_fd.Path, t_row, t_col + 1) Next s_fd '■ファイル名の取得 For Each fl In FSO.GetFolder(pt).Files '□ファイル名転記 Cells(t_row, t_col) = fl.Name '■Excel・csvファイルはハイパーリンク設定 strSplit = Split(fl.Path, ".") If UBound(strSplit) > 0 Then Select Case LCase(strSplit(UBound(strSplit))) Case "xls", "xlsx", "xlsm", "csv" ActiveSheet.Hyperlinks.Add _ Anchor:=Cells(t_row, t_col), _ Address:=fl.Path, _ TextToDisplay:=fl.Name End Select End If '□ファイルサイズ・更新日時転記 Cells(t_row, e_col + 1) = WorksheetFunction.RoundUp(fl.Size / 1024, 0) Cells(t_row, e_col + 1).NumberFormatLocal = "#,##0 ""KB""" Cells(t_row, e_col + 2) = fl.DateLastModified Cells(t_row, e_col + 2).NumberFormatLocal = "yyyy/mm/dd hh:mm:ss" '■ファイル名罫線 Call 罫線(t_row, t_col) t_row = t_row + 1 Next fl '■オブジェクトの解放 Set s_fd = Nothing Set fl = Nothing End Sub Sub 罫線(t_row As Long, t_col As Long) '■左の罫線 If t_col > s_col Then With Range(Cells(t_row, s_col), Cells(t_row, t_col - 1)) .Borders(xlEdgeLeft).LineStyle = xlContinuous .Borders(xlInsideVertical).LineStyle = xlContinuous End With End If '■上の罫線 With Range(Cells(t_row, t_col), Cells(t_row, e_col + 2)) .Borders(xlEdgeLeft).LineStyle = xlContinuous .Borders(xlEdgeTop).LineStyle = xlContinuous End With End Sub
元のExcelの画面に戻り、ボタン用に作ったオブジェクトを選択し、右クリックー[マクロの登録]を選択します。
マクロの登録画面にて、マクロの保存先ー[作業中のブック]にして「指定したフォルダ内の全階層のフォルダ名とファイル名で一覧作成」を選択し、<OK>をクリックします。
マクロを登録したボタンをクリックしてください。
いかがですか?一覧表は作成できましたか?
フォルダとファイルの処理の順番
今回の例では、フォルダとファイルの処理の順番は、下図の通りになります。
第1階層のファイルの処理が一番最後になるなんて意外ですよね。
FileSystemObjectとは
FileSystemObjectにつきましては、下記ページをご参照ください。
FileSystemObjectとは?CreateObject 関数 FolderExists・GetFolderの使い方
FileSystemObject CreateObject関数を使う方法・ 参照設定を使う方法 違いを理解してエラー防止
再帰処理とは
再帰処理につきましては、下記ページをご参照ください。
再帰処理とは?指定したフォルダの全ての階層のフォルダ名・サブフォルダ名・ファイル名を取得(Excel VBA)
Callステートメントとは
callステートメントにつきましては、下記ページをご参照ください。
Callステートメントとは
参照渡し「ByRef」と値渡し「ByVal」の違い(Excel VBA)
【参考】
指定したフォルダ内のファイル名全てを取得(Excel VBA)
変数でよく使われる「buf」「tmp」の意味
Dir関数が取得するファイルの順番
指定したフォルダ内のフォルダ名全てをGetAttrを使って「エラー53 ファイルが見つかりません。」を出さずに取得(Excel VBA)
GetAttr関数とAnd演算子でビット演算の使い方 ファイルやフォルダの属性を取得
フォルダ名だけを取得したい時に出てくる 「.」 と 「..」 とは?
指定したフォルダ内とサブフォルダ内全てのファイル名を取得(Excel VBA)
CreateObject(“Scripting.FileSystemObject”) を使ってサブフォルダを取得
再帰処理とは?フォルダ内とサブフォルダ内全てのファイル名を取得(Excel VBA)
指定したフォルダ内のサブフォルダのフォルダ名を全部取得(Excel VBA)
再帰処理とは?フォルダ内のサブフォルダのフォルダ名を全部取得(Excel VBA)
参照渡し「ByRef」と値渡し「ByVal」の違い(Excel VBA)
ファイルのフルパスからファイル名のみを取得 InStrRev関数(Excel VBA)
指定したフォルダの全ての階層のフォルダ名・サブフォルダ名・ファイル名を取得(Excel VBA)
FileSystemObjectとは?CreateObject 関数 FolderExists・GetFolderの使い方
FileSystemObject CreateObject関数を使う方法・ 参照設定を使う方法 違いを理解してエラー防止
再帰処理とは?指定したフォルダの全ての階層のフォルダ名・サブフォルダ名・ファイル名を取得(Excel VBA)
ファイルのフルパスからファイル名のみを取得 Split関数(Excel VBA)
Callステートメントとは 引数 括弧()の使い方(Excel VBA)
指定したフォルダ内から「特定の文字を含まないファイル名」を取得(Excel VBA)
ワイルドカードとは。使い方いろいろ。(Excel)
Dir関数の使い方。ファイル名やフォルダ名の取得方法。(Excel VBA)
指定したフォルダのファイル名を取得し、そのファイル名を一括で変換(Excel VBA)
Excel起動時に「コンパイルエラー」。64ビット システムで Declareステートメントに、PtrSafe属性を設定(Excel VBA )
「ファイルを開く」ダイアログボックス から ファイル名を取得(Excel VBA)
「ファイルを開く」ダイアログボックス から 複数 ファイル名を取得(Excel VBA)
指定フォルダ内のサブフォルダ全てをフォルダ構成のみ(空フォルダ)を別フォルダにコピー(Excel VBA)
再帰処理とは?指定フォルダ内のサブフォルダ全てをフォルダ構成のみ(空フォルダ)を別フォルダにコピー(Excel VBA)