【Excel VBA】フォルダ/ファイル情報表示ツール(コピペですぐ使える)


日常業務を行うにあたって、「あるフォルダ内にあるフォルダやファイルの情報を一発で知りたい。」

また、「そのフォルダにあるフォルダの数とファイルの数を一発で知りたい。」ということを思ったことはないでしょうか。

 

そんなとき、フォルダ容量やファイル数を一発で知ることができるツールがあったら良いなと思いまして、作ってみました。

 

そこで、当エクセル(ツール)があるフォルダ同階層のフォルダ容量やファイル数を取得するマクロを作成しましたので、ご活用頂けたらと思います。

 

世の中にそれらの情報を調べることができるツールは存在していますが、そのような機能をマクロで実現してみました。

 

<ツールの更新履歴>

(2022年6月29日:更新) 当ツールの直下にあるファイル/フォルダだけでなく、指定したフォルダ内にあるファイル/フォルダ情報を取得できるように変更しました。

 

 

『フォルダ/ファイル情報表示ツール』の概要

当ツールがあるフォルダと同階層にあるファイルとフォルダのサイズ、種類、パスなどの情報やフォルダの場合はその直下にあるファイル数やフォルダ数を一覧で表示します。

 

下に説明動画を載せますので、ご確認ください。

ただいま準備中・・・

 

当ツールの使用方法

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

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

 

(2022年6月29日:更新)

2.「このフォルダ内のフォルダ/ファイル情報を検索」または「フォルダを指定してフォルダ/ファイル情報を検索」ボタンをクリックします。

「フォルダを指定してフォルダ/ファイル情報を検索」をクリックした場合は、フォルダを選択するダイアログが表示されますので、対象のフォルダを指定してください。

 

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

 

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

 

使用する際の事前準備

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

 

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

 

準備の手順

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

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

 

 

2.ダウンロードしたExcelファイルの上部にあるリボンの「開発」タブから「visual basic」を選択して、VBE(visual basic for application)を起動させます。

 

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

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

 

3.「プロジェクト」に「標準モジュール」を追加して、追加された「Module1」にVBAコードを記載します。

 

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

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

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

Option Explicit

'---------(設定値)---------------------------
Private Const START_DATA_ROW = 8                    '1.テーブル見出し行の行番号
Private Const START_DATA_COL_NUM = 1                '2.テーブル見出し列の列番号
Private Const SUM_COUNT_POINT = "B5"                '3.合計ファイル数/フォルダ数のセル位置
Private Const SUM_SIZE_POINT = "B6"                 '4.合計サイズのセル位置

'---------(メッセージ)-----------------------
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
    
    'ファイル、フォルダ情報を取得する処理
    Call searchFileInfo(ThisWorkbook.Path)
    
    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
    
    'ファイル、フォルダ情報を取得する処理
    Call searchFileInfo(importDir)
    
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    
    Exit Sub
    
err:
    MsgBox EMsg1
End Sub

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

    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 row As Long: row = START_DATA_ROW
    
    Dim sumFileCnt As Long          '合計ファイル数
    Dim sumFolderCnt As Long        '合計フォルダ数
    Dim sumSize As Double           '合計サイズ
    Dim dspFormat As String         '表示書式
    
    'サブフォルダの一覧を取得
    For Each fl In pfl.subFolders
    
        On Error Resume Next
        
        'フォルダ数/ファイル数を取得する関数
        Call GetfFolderFileCnt(fl.Path)
        
        BaseSheet.Cells(row, START_DATA_COL_NUM).Value = fl.Name                            'フォルダの名称
        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                        'フォルダのパス
        
        sumSize = sumSize + fl.Size
        sumFolderCnt = sumFolderCnt + 1
        
        row = row + 1
        
        TmpFoldersCnt = 0
        TmpFilesCnt = 0
    
    Next
    
    ' ファイルの一覧を取得
    For Each f In pfl.Files
    
        '実行ファイル以外のファイルに対してファイル情報を取得する
        If InStr(f.Name, ThisWorkbook.Name) = 0 Then
        
            BaseSheet.Cells(row, START_DATA_COL_NUM).Value = f.Name                             'ファイルの名称
            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 = sumFileCnt & "ファイル " & sumFolderCnt & "フォルダ"
    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
    
End Sub

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

    Dim endRange As Range
    Set endRange = BaseSheet.Cells(START_DATA_ROW, START_DATA_COL_NUM).SpecialCells(xlLastCell)
    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    '範囲内の罫線:表示しない
        
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

 

4.ファイルを保存する際は「Excelマクロ有効ブック」を選択して、保存します。

 

(2022年6月29日:更新)

5.右端にある「このフォルダ内のフォルダ/ファイル情報を検索」と記載された図形にマクロ名「このフォルダ内のファイルフォルダ情報を検索_Click」のマクロを設定します。

 

6.右端にある「フォルダを指定してフォルダ/ファイル情報を検索」と記載された図形にマクロ名「フォルダを指定してファイルフォルダ情報を検索_Click」のマクロを設定します。

 

5、6でマクロ登録した図形にカーソルを当てて、指の形になっていたら正常に設定できています。

 

これで事前準備は完了です。

あとは「当ツールの使用方法」で記載された方法でツールを実行できます。

 

また、このようなExcelVBAを用いた業務効率化を行うときに、以下の書籍が初心者向けでとても参考になると思いますので、良かったらご参照ください。

 

なお、当マクロの開発環境として、OSは “Windows10” 、Excelのバージョンは Microsoft Office 365″ で行っており、当該環境では動作確認ができていますが、他の環境で正常に動作するかは確認できていません。

 

正常に動作しない場合は、コメントいただければ幸いです。
また、このような業務効率化できるツールを以下に一覧でまとめてありますので、ご興味のある方はご覧ください。

 

サンプルのダウンロードはこちら

下記よりExcelファイルをダウンロードして、記事の途中にありました VBAのソースコードをツール内に組み込んで使用してください。

 

【Excel VBA】フォルダ/ファイル情報表示ツール

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

 

他に要望等ありましたら、可能な限り改修等を対応しますのでコメント頂ければと思います

 

<このツールが『結構使える!』と思ったら、下のグッドボタンを押していただけたら幸いです>

コメントを残す

CAPTCHA