【知らなくても使える】フォルダ/ファイル情報を表示するマクロツール_パート２（Excel VBA）

日常業務を行うにあたって、「あるフォルダ内にあるフォルダやファイルの容量やそのフォルダにあるフォルダの数とファイルの数を一発で知りたい。」ということを思ったことはないでしょうか。

以前、フォルダ容量やファイル数を一発で知ることができる『ファイル・フォルダ情報を検索するマクロツール』をExcel VBAで作成しましたが、そのツールのパート２になります。

ちなみにパート１は以下になります。

【知らなくても使える】フォルダ/ファイル情報を表示するマクロツール（Excel VBA）日常業務を行うにあたって、「あるフォルダ内にあるフォルダやファイルの容量やそのフォルダにあるフォルダの数とファイルの数を一発で知りた...

変更した箇所は以下になります。

選択したフォルダ内にあるサブファイル、サブフォルダを含めた全ての情報を表示します。
表示したサブフォルダ等の情報は一番左より折りたたむことができます。

当記事にはマクロの元になるExcelファイルがダウンロード可能で、VBAのコードも記事内に記載がありますので、Excel VBAやマクロが良く分からないという方でもすぐに使用できます。

当ツールを使用すれば定例業務の業務効率化が図れるかと思いますので、是非ご活用頂けたらと思います。

記事の目次

『フォルダ/ファイル情報表示ツール（パート２）』の概要
- 基本的な機能、操作方法の説明
- 留意事項
使用する際の事前準備
- 準備の手順
  - VBAのソースコードはこちら
ツールのダウンロードはこちら

『フォルダ/ファイル情報表示ツール（パート２）』の概要

当ツールがあるフォルダ内にある全てのファイルとフォルダのサイズ、種類、パスなどの情報やフォルダ内のファイル数やフォルダ数を一覧で表示します。

基本的な機能、操作方法の説明

フォルダ/ファイル情報表示ツールのマクロが入ったExcelファイル（***.xlsm）を開きます。

当該Excelファイルで以下の二つの検索ができます。

＜当ツールがあるフォルダと同階層のファイル/フォルダ情報を検索したい場合＞

「当ツールがあるフォルダ内のフォルダ/ファイル情報を検索」ボタンをクリックします。

開いているExcelファイルと同階層にあるファイルとフォルダの情報が表示されます。

各フォルダ、ファイルのプロパティから確認した情報はこちら

＜指定したフォルダ内にあるファイル/フォルダ情報を検索したい場合＞

「指定したフォルダ内のフォルダ/ファイル情報を検索」ボタンをクリックします。
表示されたファイル/フォルダ指定ダイアログより、対象のフォルダを選択します。
「OK」をクリックします。

指定したフォルダにあるファイル/フォルダ情報が表示されます。

検索結果の一覧はサブフォルダの情報は左より折りたたむことができます。

留意事項

当マクロを使用するにあたって、以下の場合は実行完了までに時間がかかることがあります。

指定したフォルダ内にあるファイル数が多い
指定したフォルダのファイル容量が大きい

動作が完了しない場合は、Escを連打して、表示されたメッセージ内で「終了」を選択し、処理を途中で終了させてください。

必要に応じて、更に下位階層のフォルダを選択し再度ツールを実行させてください。

使用する際の事前準備

このページの下部にある「Excelファイルのサンプル」からExcelファイルを取得し、「準備の手順」内にあるVBAコードを取得したExcelファイルに記載して保存すれば、すぐに当ツールを使用できます。

以下にその手順を説明していきます。

準備の手順

＜手順１＞

「サンプルのダウンロードはこちら」からサンプル（Excelファイル）をダウンロードし、ファイルを開きます。

※インターネットにあるマクロファイルをダウンロードすることはセキュリティ上リスクがあるので、マクロ無しExcelファイルを公開しています。

＜手順２＞

ダウンロードしたExcelファイルを開いて、VBE（Visual Basic Editor）を起動させます。

Excelファイルの上部にあるリボンの「開発」タブを選択します。
「Visual Basic」をクリックして、VBE（Visual Basic Editor）を起動させます。

リボンに「開発」タブが表示されていない場合は、以下を参照ください。

（参考サイト：記事「Excel VBAを始める前に、最初にやっておくべき初期設定内容はこれ」の『開発』タブを表示させる）

＜手順３＞

「Microsoft Excel Object」を右クリックします。
「挿入」を選択します。
「標準モジュール」をクリックします。

＜手順４＞

「Module1」をダブルクリックします。
表示されている右側の欄（エディター）に以下のVBAコードを記載します。

VBAのソースコードはこちら

以下のVBAコードをコピーして、「Module1」内のエディターに貼り付けます。

※VBAコードの右上のアイコンをクリックするとソースコードをコピーできます

Option Explicit

'---------（設定値）---------------------------
Private Const START_DATA_ROW = 10                   '１．テーブル見出し行の行番号
Private Const START_DATA_COL_NUM = 2                '２．テーブル見出し列の列番号
Private Const SUM_COUNT_POINT = "C5"                '３．合計ファイル数/フォルダ数のセル位置
Private Const SUM_SIZE_POINT = "C6"                 '４．合計サイズのセル位置
Private Const CHILDREN_ID = "- "

'---------（メッセージ）-----------------------
Private Const Msg1 = "検索ワードを入力してください。"
Private Const Msg2 = "検索対象が見つかりませんでした。"
Private Const Msg3 = "ファイル/フォルダ情報を検索する対象のフォルダを指定して下さい。"
Private Const EMsg1 = "予期せぬエラーが発生しました"
'----------------------------------------------

Private TmpFilesCnt As Long
Private TmpFoldersCnt As Long
Private BaseSheet As Worksheet

'===========================================
'このフォルダ内のファイル/フォルダ情報検索を実行した際のメイン処理
'===========================================
Sub このフォルダ内のファイルフォルダ情報を検索_Click()

    On Error GoTo err
    
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    Set BaseSheet = ThisWorkbook.ActiveSheet
    
    '初期処理
    Call Initialize
    
    Dim row As Long: row = START_DATA_ROW
    Dim childCnt As Long
    
    'ファイル、フォルダ情報を取得する処理
    Call searchFileInfo(ThisWorkbook.Path, row, childCnt)
    
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    
    Exit Sub
    
err:
    MsgBox EMsg1
    
End Sub

'===========================================
'フォルダを指定してファイル/フォルダ情報検索を実行した際のメイン処理
'===========================================
Sub フォルダを指定してファイルフォルダ情報を検索_Click()
    
    On Error GoTo err
    
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    Set BaseSheet = ThisWorkbook.ActiveSheet
    
    '初期処理
    Call Initialize
    
    Dim importDir As String         '検索するファイル等が入っている対象のフォルダ
        
    'フォルダ選択ダイアログを表示させる
    With Application.FileDialog(msoFileDialogFolderPicker)
    
        .Title = Msg3
        
        If .Show <> 0 Then
            importDir = .SelectedItems(1)
        Else
            End
        End If
    
    End With
    
    Dim row As Long: row = START_DATA_ROW
    Dim childCnt As Long
    
    'ファイル、フォルダ情報を取得する処理
    Call searchFileInfo(importDir, row, childCnt)
    
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    
    Exit Sub
    
err:
    MsgBox EMsg1
End Sub

'-------------------------------------
'指定したフォルダ内にあるファイル/フォルダの情報を取得する
'-------------------------------------
Sub searchFileInfo(folderPath As String, row As Long, childCnt As Long)

    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")        'ファイルシステムオブジェクトの生成

    Dim pfl As Object                                           '親フォルダ
    Set pfl = fso.GetFolder(folderPath)                         '親フォルダを取得
    Dim fl As Object                                            '子フォルダ
    Dim f As Object                                             '子ファイル

    Dim sumFileCnt As Long                      '合計ファイル数
    Dim sumFolderCnt As Long                    '合計フォルダ数
    Dim sumSize As Double                       '合計サイズ
    Dim dspFormat As String                     '表示書式
    Dim gStartRow As Long: gStartRow = row      'グループ作成時のスタート行
    
    'サブフォルダの一覧を取得
    For Each fl In pfl.subFolders
    
        On Error Resume Next
        
        'フォルダ数/ファイル数を取得する関数
        Call GetfFolderFileCnt(fl.Path)
        
        'フォルダの名称
        If childCnt <> 0 Then
            BaseSheet.Cells(row, START_DATA_COL_NUM).Value = String(childCnt, "　") & CHILDREN_ID & fl.Name
        Else
            BaseSheet.Cells(row, START_DATA_COL_NUM).Value = fl.Name
        End If
        
        BaseSheet.Cells(row, START_DATA_COL_NUM + 1).Value = fl.Type                        'フォルダの種類
        BaseSheet.Cells(row, START_DATA_COL_NUM + 2).Value = GetSize(fl.Size, dspFormat)    'フォルダのサイズ
        BaseSheet.Cells(row, START_DATA_COL_NUM + 2).NumberFormatLocal = dspFormat          '書式を変更する
        BaseSheet.Cells(row, START_DATA_COL_NUM + 3).Value = TmpFoldersCnt                  'フォルダ数
        BaseSheet.Cells(row, START_DATA_COL_NUM + 4).Value = TmpFilesCnt                    'ファイル数
        BaseSheet.Cells(row, START_DATA_COL_NUM + 5).Value = fl.Path                        'フォルダのパス
        BaseSheet.Range(Cells(row, START_DATA_COL_NUM), Cells(row, START_DATA_COL_NUM + 5)).Font.Color = RGB(198, 89, 17)    'フォルダに関しては文字色を濃オレンジ色に変える
        
        sumSize = sumSize + fl.Size
        sumFolderCnt = sumFolderCnt + 1
        
        row = row + 1
        
        TmpFoldersCnt = 0
        TmpFilesCnt = 0
    
        childCnt = childCnt + 1
        
        'サブフォルダ内のファイルを取得する（再帰的に呼び出し）
        Call searchFileInfo(fl.Path, row, childCnt)
        
        childCnt = childCnt - 1
        
    Next
    
    ' ファイルの一覧を取得
    For Each f In pfl.Files
    
        '実行ファイル以外のファイルに対してファイル情報を取得する
        If InStr(f.Name, ThisWorkbook.Name) = 0 Then
        
            'ファイルの名称
            If childCnt <> 0 Then
                BaseSheet.Cells(row, START_DATA_COL_NUM).Value = String(childCnt, "　") & CHILDREN_ID & f.Name
            Else
                BaseSheet.Cells(row, START_DATA_COL_NUM).Value = f.Name
            End If
            
            BaseSheet.Cells(row, START_DATA_COL_NUM + 1).Value = f.Type                         'ファイルの種類
            BaseSheet.Cells(row, START_DATA_COL_NUM + 2).Value = GetSize(f.Size, dspFormat)     'ファイルのサイズ
            BaseSheet.Cells(row, START_DATA_COL_NUM + 2).NumberFormatLocal = dspFormat          '書式を変更する
            BaseSheet.Cells(row, START_DATA_COL_NUM + 3).Value = "-"                            'フォルダ数（ハイフン固定）
            BaseSheet.Cells(row, START_DATA_COL_NUM + 4).Value = "-"                            'ファイル数（ハイフン固定
            BaseSheet.Cells(row, START_DATA_COL_NUM + 5).Value = f.Path                         'ファイルのパス
            
            sumSize = sumSize + f.Size
            sumFileCnt = sumFileCnt + 1
            
            row = row + 1
        End If
    Next
    
    BaseSheet.Range(SUM_COUNT_POINT).Value = sumFolderCnt & "フォルダ / " & sumFileCnt & "ファイル"
    BaseSheet.Range(SUM_SIZE_POINT).Value = GetSize(sumSize, dspFormat)
    BaseSheet.Range(SUM_SIZE_POINT).NumberFormatLocal = dspFormat
    
    Dim endRow As Long
    Dim endCol As Long
    
    '表の最終行番号を取得する
    endRow = Cells.Find(What:="*", LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).row
    endCol = Cells.Find(What:="*", LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Column
    
    Dim bs As Borders
    Set bs = Range(Cells(START_DATA_ROW, START_DATA_COL_NUM), Cells(endRow, endCol)).Borders ' 上下左右の罫線
    
    bs.LineStyle = xlContinuous     '罫線：実践（細）
    bs.ColorIndex = 15              '罫線色：灰色
    
    Set fso = Nothing
    If childCnt <> 0 Then
        Rows(gStartRow & ":" & endRow).Rows.Group
    End If
    
End Sub

'-------------------------------------
'初期処理を行う（表内の値の削除、罫線の削除）
'-------------------------------------
Sub Initialize()

    Dim endRange As Range
    Set endRange = BaseSheet.Cells(START_DATA_ROW, START_DATA_COL_NUM).SpecialCells(xlLastCell)
    BaseSheet.Range(SUM_COUNT_POINT).ClearContents                                                                                          '合計フォルダ数/ファイル数の値を削除
    BaseSheet.Range(SUM_SIZE_POINT).ClearContents                                                                                           '合計サイズの値を削除
    BaseSheet.Range(Cells(START_DATA_ROW, START_DATA_COL_NUM), Cells(endRange.row, endRange.Column)).ClearContents                          '範囲内の数式と文字を削除
    BaseSheet.Range(Cells(START_DATA_ROW, START_DATA_COL_NUM), Cells(endRange.row, endRange.Column)).Borders.LineStyle = xlLineStyleNone    '範囲内の罫線：表示しない
    BaseSheet.Range(Cells(START_DATA_ROW, START_DATA_COL_NUM), Cells(endRange.row, endRange.Column)).Font.Color = RGB(64, 64, 64)           '文字色を濃灰色にする
    Rows(START_DATA_ROW & ":" & endRange.row).Rows.ClearOutline                                                                             'グループ化を解除する
    
End Sub

'-------------------------------------
'ファイルサイズを取得する
'　※丸め処理をする
'-------------------------------------
Function GetSize(roundSize As Double, Optional ByRef dspFmt As String)

    Dim fileSize As String
    
    If roundSize > 1000000000 Then
        fileSize = Round(roundSize / 1000000000, 3)
        dspFmt = "###.###,,,"" GB"""
    ElseIf roundSize > 1000000 Then
        fileSize = Round(roundSize / 1000000, 3)
        dspFmt = "###.###,,"" MB"""
    ElseIf roundSize > 1000 Then
        fileSize = Round(roundSize / 1000, 3)
        dspFmt = "###.###,"" KB"""
    Else
        fileSize = roundSize
        dspFmt = "###.###"" B"""
    End If
    
    GetSize = roundSize

End Function

'-------------------------------------
'フォルダ内のファイルとフォルダ数を取得する
'　※再帰的に取得する
'-------------------------------------
Private Sub GetfFolderFileCnt(folderPath As String)
    
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    Dim fileCnt As Variant
    Dim folderCnt As Variant
    
    If fso.GetFolder(folderPath).subFolders.Count > 0 Then

        'フォルダパスを指定してすべてのサブフォルダを取得
        Dim subFolders As Object
        
        For Each subFolders In fso.GetFolder(folderPath).subFolders
            Call GetfFolderFileCnt(subFolders.Path)     'サブフォルダが存在した場合は再帰処理をする
            TmpFoldersCnt = TmpFoldersCnt + 1
        Next subFolders

    End If
    
    TmpFilesCnt = TmpFilesCnt + fso.GetFolder(folderPath).Files.Count

    Set fso = Nothing
    
End Sub

＜手順５＞

マクロを含んだExcelとして、ファイルを保存します。