Excel でカウントディレクトリのファイルに加えてサブディレクトリに含まれるファイルの一覧を出力するマクロの作成方法についてご紹介します。

ちょっと専門用語が多かったような気もするので、

要するにあるフォルダ内にフォルダの中のファイルも全部含めてファイル一覧させる方法についてご紹介します。

今回は Excel Vba を使います。

自分でつくってみてだいたい１～２時間くらいでできましたが、結構簡単なのでぜひ興味のある方は参考にしてみてください。

※実際に作成したマクロは下記からダウンロードできますので、興味のある方はぜひダウンロードしてみてください。

作成方法

ご紹介します Excel マクロは大きく二つの機能から構成されています。

ファイル一覧を出力するパスを取得

ファイル一覧を表示させるためのファイルパスを取得するための機能をご紹介します。

下記画面のように「フォルダパス取得」ボタンを押下することで、ファイル一覧を表示させるためのファイルパス（下画面なら「C:\test」)を表示させます。

下記にソースコードを記載します。

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セルに書き込むというそれだけの処理です。

取得したパスからファイル一覧を出力

これは「ファイル一覧出力」ボタンを押下することで、取得したパスのファイル一覧出力を出力させる処理です。

処理は下記の順番になります。順を追って説明していきます。

取得したパスが正しい値であるかを確認

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

シートの初期化

これは処理を行う前にシートをきれいにする処理のことです。

具体的には、ファイル一覧を出力しているセル範囲（B6以降のセル）の値のみを削除しています（書式は削除していません）。

ソースコード

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はフォルダ内にあるファイルを変数に格納させた値と思ってください。

※ ファイル名の処理

まず、フォルダ内のファイルのフルパス fileName.Path とし、その fileName.Pathの後方から最初に来る「\」よりも後ろの値を取得します。

何言っているかよくわからない方もいると思いますので、もう少し具体的に説明しますと

例えばフォルダ内のファイルのフルパス fileName.Pathが以下のような値としますと、

slashNum = InStrRev(fileName.Path, "\")
        'セルにパスとファイル名を書き込む
        Worksheets(FOLDERPATH).Cells(start_y, start_x).Value = Mid(fileName.Path, slashNum + 1)

次にフォルダ内にあるサブフォルダ（サブディレクトリ）については、GetFolder関数を用いて取得します。

そして再帰処理（つまり処理を繰り返す）を行い、サブフォルダが見つからなくなくなるまで処理をくり返します。

その処理を繰り返している間も、そのフォルダに含まれるファイル名はすべて出力するようにします。

下記にソースコードを記載します。

' ファイル一覧作成
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

最後に

いかがでしょうか？

もしつくるのめんどくせえとか実際に作ったのがそんなのか見てみたい！という人がいましたら下記ボタンからダウンロードできますので、ぜひ試してみてください。