【本日のミッション】
Excel VBAにて指定したフォルダの全ての階層のフォルダ名・サブフォルダ名・ファイル名を取得し、一覧表を作成せよ。
以前お話ししました
指定したフォルダ内のサブフォルダのフォルダ名を全部取得(Excel VBA)
指定したフォルダ内とサブフォルダ内全てのファイル名を取得(Excel VBA)
から更に進歩です!!
- セルB3に、フォルダ・サブフォルダ・ファイル名を取得したいフォルダのパスを入力
- セルB6に、一覧表を作りたいセル範囲の左上のセルアドレスを入力
- <フォルダ・ファイル名一覧作成>ボタンをポチっと
すると、セルB6に入力したアドレスに、ファイル・フォルダ一覧表が完成!
という、夢のようなVBAの作成です♪
対象フォルダパス「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に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とは?CreateObject 関数 FolderExists・GetFolderの使い方
FileSystemObject CreateObject関数を使う方法・ 参照設定を使う方法 違いを理解してエラー防止
■再帰処理とは
再帰処理とは?指定したフォルダの全ての階層のフォルダ名・サブフォルダ名・ファイル名を取得(Excel VBA)
■Callステートメントとは
Callステートメントとは
参照渡し「ByRef」と値渡し「ByVal」の違い(Excel VBA)
【参考】
指定したフォルダ内のファイル名全てを取得(Excel VBA)
変数でよく使われる「buf」「tmp」の意味
Dir関数が取得するファイルの順番
指定したフォルダ内のフォルダ名全てをGetAttrを使って「エラー53 ファイルが見つかりません。」を出さずに取得(Excel VBA)
GetAttrとは?「= vbDirectory」ではなく「And vbDirectory」となるビット演算の疑問
フォルダ名だけを取得したい時に出てくる 「.」 と 「..」 とは?
指定したフォルダ内とサブフォルダ内全てのファイル名を取得(Excel VBA)
CreateObject(“Scripting.FileSystemObject”) を使ってサブフォルダを取得
再帰処理とは?フォルダ内とサブフォルダ内全てのファイル名を取得(Excel VBA)
指定したフォルダ内のサブフォルダのフォルダ名を全部取得(Excel VBA)
参照渡し「ByRef」と値渡し「ByVal」の違い(Excel VBA)
Callステートメントとは
再帰処理とは?フォルダ内のサブフォルダのフォルダ名を全部取得(Excel VBA)
FileSystemObjectとは?CreateObject 関数 FolderExists・GetFolderの使い方
FileSystemObject CreateObject関数を使う方法・ 参照設定を使う方法 違いを理解してエラー防止
再帰処理とは?指定したフォルダの全ての階層のフォルダ名・サブフォルダ名・ファイル名を取得(Excel VBA)
指定したフォルダ内から「特定の文字を含まないファイル名」を取得(Excel VBA)
■スポンサーリンク
■ランキングに参加しています。 ↓このブログを気に入っていただけましたら、ポチッとお願いします。
にほんブログ村