指定したドライブのそれぞれのフォルダにどれぐらいのファイルが保存されているかを再帰的に調査しファイル数およびデータ容量を表示するExcel VBAプログラムを作成してください。プログラムは以下の要件を満たしてください

以下は、指定された要件を満たすExcel VBAプログラムの例です。このプログラムは、指定されたフォルダ内のファイル数とデータ容量を再帰的に調査し、結果をテーブルに出力します。

Sub FolderAnalysis()
    Dim targetFolder As String
    Dim ws As Worksheet
    Dim tbl As ListObject
    Dim currentRow As ListRow

    ' 対象フォルダの取得
    targetFolder = ThisWorkbook.Sheets("Sheet1").Range("対象フォルダ").Value

    ' 結果テーブルの取得
    Set ws = ThisWorkbook.Sheets("Sheet1")
    Set tbl = ws.ListObjects("検索結果")

    ' テーブルのクリア
    On Error Resume Next
    tbl.DataBodyRange.Delete
    On Error GoTo 0

    ' フォルダの解析
    AnalyzeFolder targetFolder, tbl

    MsgBox "フォルダ解析が完了しました。"
End Sub

Sub AnalyzeFolder(folderPath As String, tbl As ListObject)
    Dim fso As Object
    Dim folder As Object
    Dim subFolder As Object
    Dim file As Object
    Dim fileCount As Long
    Dim totalSize As Double
    Dim currentRow As ListRow

    ' 処理中のフォルダ名を表示
    ThisWorkbook.Sheets("Sheet1").Range("処理中").Value = folderPath

    ' FileSystemObjectの作成
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set folder = fso.GetFolder(folderPath)

    ' ファイル数とサイズの初期化
    fileCount = 0
    totalSize = 0

    ' フォルダ内のファイルをカウント
    For Each file In folder.Files
        fileCount = fileCount + 1
        totalSize = totalSize + file.Size
    Next file

    ' サブフォルダの解析
    For Each subFolder In folder.SubFolders
        AnalyzeFolder subFolder.Path, tbl
        fileCount = fileCount + subFolder.Files.Count
        totalSize = totalSize + GetFolderSize(subFolder.Path)
    Next subFolder

    ' 結果をテーブルに追加
    Set currentRow = tbl.ListRows.Add
    currentRow.Range(1, 1).Value = folderPath
    currentRow.Range(1, 2).Value = fileCount
    currentRow.Range(1, 3).Value = totalSize / 1024 ' KB単位で表示

End Sub

Function GetFolderSize(folderPath As String) As Double
    Dim fso As Object
    Dim folder As Object
    Dim file As Object
    Dim subFolder As Object
    Dim totalSize As Double

    ' FileSystemObjectの作成
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set folder = fso.GetFolder(folderPath)

    ' フォルダ内のファイルサイズを合計
    totalSize = 0
    For Each file In folder.Files
        totalSize = totalSize + file.Size
    Next file

    ' サブフォルダのサイズを合計
    For Each subFolder In folder.SubFolders
        totalSize = totalSize + GetFolderSize(subFolder.Path)
    Next subFolder

    GetFolderSize = totalSize
End Function

このプログラムを実行する前に、以下の準備を行ってください:

  1. Excelシートに「対象フォルダ」という名前のセルを作成し、調査したいフォルダのパスを入力します。
  2. Excelシートに「処理中」という名前のセルを作成します。
  3. 「検索結果」という名前のテーブルを作成し、列名を「フォルダ名」、「ファイル数」、「データ容量」とします。

このプログラムがうまく動作することを願っています。何か質問があれば、お知らせください!

対象フォルダセルをダブルクリックしたときにフォルダ選択ダイアログが表示され、結果を対象フォルダセルに入力する処理を作成してください

以下のコードを使用して、対象フォルダセルをダブルクリックしたときにフォルダ選択ダイアログを表示し、選択したフォルダパスを対象フォルダセルに入力する処理を追加できます。

まず、以下のコードを標準モジュールに追加します:

Sub SelectFolder()
    Dim folderPath As String
    folderPath = GetFolderPath()
    If folderPath <> "" Then
        ThisWorkbook.Sheets("Sheet1").Range("対象フォルダ").Value = folderPath
    End If
End Sub

Function GetFolderPath() As String
    Dim fldr As FileDialog
    Dim sItem As String
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = "フォルダを選択してください"
        .AllowMultiSelect = False
        If .Show <> -1 Then GoTo NextCode
        sItem = .SelectedItems(1)
    End With
NextCode:
    GetFolderPath = sItem
    Set fldr = Nothing
End Function

次に、対象フォルダセルをダブルクリックしたときに上記のコードを実行するために、以下のコードを対象シートのコードモジュールに追加します:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Address = ThisWorkbook.Sheets("Sheet1").Range("対象フォルダ").Address Then
        Cancel = True
        SelectFolder
    End If
End Sub

これで、対象フォルダセルをダブルクリックするとフォルダ選択ダイアログが表示され、選択したフォルダパスが対象フォルダセルに入力されるようになります。

何か他にお手伝いできることがあれば、教えてください!

処理中フォルダに表示される処理中フォルダのパスを、フルパスではなく最も深いフォルダのフォルダ名にしてください

以下のようにコードを修正して、処理中フォルダのパスをフルパスではなく最も深いフォルダのフォルダ名だけを表示するようにできます。

まず、AnalyzeFolderサブプロシージャ内の処理中フォルダ名を表示する部分を修正します:

Sub AnalyzeFolder(folderPath As String, tbl As ListObject)
    Dim fso As Object
    Dim folder As Object
    Dim subFolder As Object
    Dim file As Object
    Dim fileCount As Long
    Dim totalSize As Double
    Dim currentRow As ListRow
    Dim folderName As String

    ' フォルダ名を取得
    folderName = GetFolderName(folderPath)

    ' 処理中のフォルダ名を表示
    ThisWorkbook.Sheets("Sheet1").Range("処理中").Value = folderName

    ' FileSystemObjectの作成
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set folder = fso.GetFolder(folderPath)

    ' ファイル数とサイズの初期化
    fileCount = 0
    totalSize = 0

    ' フォルダ内のファイルをカウント
    For Each file In folder.Files
        fileCount = fileCount + 1
        totalSize = totalSize + file.Size
    Next file

    ' サブフォルダの解析
    For Each subFolder In folder.SubFolders
        AnalyzeFolder subFolder.Path, tbl
        fileCount = fileCount + subFolder.Files.Count
        totalSize = totalSize + GetFolderSize(subFolder.Path)
    Next subFolder

    ' 結果をテーブルに追加
    Set currentRow = tbl.ListRows.Add
    currentRow.Range(1, 1).Value = folderPath
    currentRow.Range(1, 2).Value = fileCount
    currentRow.Range(1, 3).Value = totalSize / 1024 ' KB単位で表示

End Sub

Function GetFolderName(folderPath As String) As String
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    GetFolderName = fso.GetFolder(folderPath).Name
End Function