ファイル一覧をシートに表示する
概要
- Scripting.FileSystemObjectのgetFolderを使用してサブフォルダを取得
- Dir関数の引数に[フォルダパス]+*.*を指定してフォルダに格納されている全てのファイルを取得
// vbNormal (0) : 標準ファイル
buf = Dir(folderpath & "\*.*", vbNormal)
Do While buf <> ""
// Dir関数は次の引数を指定するまで前回指定引数の結果を返す
// 返す結果がないときは空文字を返す
buf = Dir()
Debug.Print buf
Loop- 再帰的に「ファイル一覧を取得」関数を呼び出してファイルリストを作成
動作検証環境
Windows10 Pro／Windows11 Pro
Microsoft365 Excelバージョン2110
実行イメージ
概要
適当なところにソースを貼り付けてください。
ブックを開いたときにルートフォルダを指定するフォルダ選択ダイアログを表示していますがブックを開くイベントハンドラはVBEでオブジェクトにWorkbook、プロシージャにOpenを指定すると手入力しなくてもプロシージャが自動設定されます。
特定のファイル拡張子のみ抽出したい場合は「*.*」を「sample*」や「*.png」などに変更してください。
// sampleで始まるファイル一覧を抽出する
buf = Dir(folderpath & "\sample*", vbNormal)
Do While buf <> ""
// Dir関数は次の引数を指定するまで前回指定引数の結果を返す
// 返す結果がないときは空文字を返す
buf = Dir()
Debug.Print buf
Loopソースコード
'//ワークブックオープンでフォルダ選択ダイアログを表示
Private Sub Workbook_Open()
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = True Then
ファイル一覧 .SelectedItems(1)
End If
End With
End Sub
'//選択されたフォルダのファイル一覧を取得するプロシージャをコール
Sub ファイル一覧(ByVal folpath As String)
'全て(数式、文字列、書式、コメント、アウトライン)クリア
Cells.Select
Selection.UnMerge
Selection.Clear
'列の幅、フォントサイズをセット
Selection.ColumnWidth = 4
Selection.Font.Size = 9
Range("A1").Select
'ファイル一覧をサブフォルダまで取得して表示する
Application.ScreenUpdating = False
Call ファイル一覧を取得(folpath, 1, 0)
Application.ScreenUpdating = True
'終了メッセージ
MsgBox "おわりました", vbInformation
End Sub
'//ファイル一覧を再帰的に取得してシートに表示する
'//引数 gyo：出力開始行番号
'// clm：出力開始列番号(1列目からの相対値)
Sub ファイル一覧を取得(ByVal folpath As String, ByRef gyo As Long, ByVal clm As Integer)
Dim buf As String
Dim fol As Object
'ルートフォルダを表示
Cells(gyo, 1) = "【" & CStr(gyo) & "】"
Cells(gyo, 2 + clm) = folpath
gyo = gyo + 1
'ファイル一覧を取得
buf = Dir(folpath & "\*.*", vbNormal)
Do While buf <> ""
Cells(gyo, 1) = "【" & CStr(gyo) & "】"
Cells(gyo, 2 + clm) = "∟"
Cells(gyo, 2 + clm + 1) = buf
gyo = gyo + 1
'Dir関数は次の引数を指定するまで前回指定引数の結果を返す
buf = Dir()
Loop
'サブフォルダからファイル一覧を取得
With CreateObject("Scripting.FileSystemObject")
For Each fol In .getFolder(folpath).SubFolders
Call ファイル一覧を取得(fol.Path, gyo, clm + 1)
Next fol
End With
End Sub
