EXCEL VBA フォルダー内のファイル名をシートに一覧表示（サブフォルダー含める：再帰呼び出し）テクニック

2020年7月25日

EXCEL VBA フォルダー内のファイル名・ファイルサイズ・更新日時をシートに一覧表示（サブフォルダー含める：Call　再帰呼び出し）テクニック

●はじめに

今回説明するプログラムは、選択したフォルダー内（サブフォルダー含む）のファイル一覧をEXCELシートに一覧表示させるサンプルプログラムです。今回のプログラムについては、Call【再帰呼び出し】を利用して階層のあるフォルダーに対しても各フォルダー内のファイル情報を取得する事が出来ます。

●プログラム説明

下記のサンプルプログラムは、フォルダーを選択してファイルの一覧をEXCELシートにファイルパス・ファイル名・ファイル容量「KB単位」・更新日時を一覧表示させます。

【プログラム内容】
選択フォルダーは【TEST】このフォルダーが親フォルダーとなり、この【TEST】フォルダーを元に下位フォルダー内のファイルを含めて全てのファイル一覧をEXCELシートに一覧表示します。

【プログラム実行前】

【プログラム実行後】

【プログラム実行手順・内容】

・プログラム①　・・・フォルダーを選択をファイル内容を転記するワークシートの書式を設定します。
・プログラム②　・・・フォルダーパスを受け取り、フォルダー内のファイル一覧をファイル一覧に転記します。

【プログラム実行条件】
・プログラム①及びプログラム②共に登録します。（プログラム①）を実行します。

【プログラム①】・・メインプログラム

'
'******** AKIRA55.COM ******* https://akira55.com/filelist/
'
Sub fileList01()  '選択したフォルダー（サブフォルダー含む）のファイル一覧作成

    Dim Add As Range
    Dim Hani As String
    
    Cells.Clear 'シート内容をクリアー
    
    Range("A1") = 1: Range("B1") = "ファイルパス"
    Range("C1") = "容量（KB）": Range("D1") = "更新日時"
    
    For Each Add In Range("A1:D1")
         Add.Interior.ColorIndex = 20    '背景色を指定します。
    Next Add
    
    With Application.FileDialog(msoFileDialogFolderPicker) 'ダイアログボックスが表示されてフォルダー選択します。
        If .Show = True Then
                Call fileList_sub(.SelectedItems(1)) 'フォルダーが選択されていれば、サブプログラムを実行
            Else
                MsgBox "フォルダーを選択しませんでした。"
                Exit Sub 'プログラム終了
        End If
        
    End With
    
    Hani = Range("A1").CurrentRegion.Address(False, False) 'セルA1から始まる表の範囲を取得
    
    Range(Hani).Borders.LineStyle = xlContinuous '格子罫線を作成：細実線
    

End Sub
'

'******** AKIRA55.COM ******* https://akira55.com/filelist/

Sub fileList01() '選択したフォルダー（サブフォルダー含む）のファイル一覧作成

Dim Add As Range

Dim Hani As String

Cells.Clear 'シート内容をクリアー

Range("A1") = 1: Range("B1") = "ファイルパス"

Range("C1") = "容量（KB）": Range("D1") = "更新日時"

For Each Add In Range("A1:D1")

Add.Interior.ColorIndex = 20 '背景色を指定します。

Next Add

With Application.FileDialog(msoFileDialogFolderPicker) 'ダイアログボックスが表示されてフォルダー選択します。

If .Show = True Then

Call fileList_sub(.SelectedItems(1)) 'フォルダーが選択されていれば、サブプログラムを実行

Else

MsgBox "フォルダーを選択しませんでした。"

Exit Sub 'プログラム終了

End If

End With

Hani = Range("A1").CurrentRegion.Address(False, False) 'セルA1から始まる表の範囲を取得

Range(Hani).Borders.LineStyle = xlContinuous '格子罫線を作成：細実線

End Sub

【プログラム②】・・・サブプログラム

Sub fileList_sub(Path As String)  '選択フォルダーパスを受け取りフォルダー内のファイル一覧を作成します。
    Dim Sub_forlder As Object
    Dim Temp As String
    Dim I, F As Long
    
    Temp = Dir(Path & "\*.*")  '選択ファルダー内の最初のファイルを選択します。
    
    Do While Temp <> "" '全てのファイルを繰り返します。
        
        I = Range("A1") '行番号を代入
        I = I + 1 'ファイル内容を転記する行番号を加算します。
        
        Cells(I, "A") = I - 1  'A列に件数を表示します。
        Cells(I, "B") = Path & "\" & Temp  'フォルダーパスとファイル名を表示します。
        Cells(I, "C") = Format(FileLen(Path & "\" & Temp), "#,###,") & "KB" '容量をKB単位で表示
        Cells(I, "D") = Format(FileDateTime(Path & "\" & Temp), "YYYY/MM/DD")  '更新日時を表示
        Range("A1") = I  'セルA1に件数カウントする。
        
        Temp = Dir() '次のファイルを選択します。
    Loop
     
    With CreateObject("Scripting.FileSystemObject")
        
        For Each Sub_forlder In .GetFolder(Path).SubFolders  'すべてのフォルダーを繰り返します。
            
            Call fileList_sub(Sub_forlder.Path)  '再帰呼び出しを行いフォルダパスからサブフォルダ内容を取得
        
        Next Sub_forlder
    
    End With
    
End Sub

'