フォルダーサイズ（VBA研究会議事録_04）

VBA研究会で論じられた内容を記録する議事録の4本目です。前回の議事録はコチラになります。

hirocom777.hatenadiary.org

前回は作業ログ作成の機能拡張に取り組みました。

今回はフォルダーサイズの取得についてです。Windows上では個別フォルダーのサイズ確認はできますが、一覧は取得できません。一括表示できるようなると便利です。

サンプルファイルもご用意しましたので参考にしてください drive.google.com

FSO（FileSystemObject）

結論から言うと、この課題はFSO（FileSystemObject）を使用することで解決できます。FSOを使うには、以下の手順を踏みます。「ツール」→「参照設定」に、「Microsoft Scripting Runtime」にチェックを付ける。

この手順による方法を「事前バインディング」とよびます。他にも「遅延バインディング」という手法があります。上の設定を省いてコーディングだけで使用できるのですが、できるだけ事前バインディングを使いましょう。理由は以下を参考にしてください。

excel-ubara.com

実際に使用するには

Dim オブジェクト変数 As New Scripting.FileSystemObject

としてオブジェクトを作成して使用します。

実際のコード

それでは実際のコードです。結果を表記するシートモジュールに記述してあります。まずはフォルダーの選択する部分から。

'フォルダーを選択します
Public Sub SelectFolder()
  'ダイアログを表示してフォルダを指定します
  With Application.FileDialog(msoFileDialogFolderPicker)
    If .Show = 0 Then Exit Sub 'キャンセル時は終了
    Me.Range("B1").Value = .SelectedItems(1)
  End With

  'フォルダ名とフォルダサイズを取得、表示します
  Call DispFolders(Me.Range("B1").Text, Me.Range("B3"))
End Sub

続いて、上で選択したフォルダーからフォルダー内情報を取得、表示するプロシージャです。

'フォルダ名とフォルダサイズを取得、表示します
Private Sub DispFolders(folderPath As String, rng As Range)
  'ファイルシステムオブジェクト、フォルダオブジェクトを作成します
  Dim objFso As New Scripting.FileSystemObject
  Dim objFolder As Object
  Set objFolder = objFso.GetFolder(folderPath)

  'フォルダ名とフォルダサイズを取得、表示します
  Dim objSubFolder As Object
  Dim countRow As Long: countRow = 0
  For Each objSubFolder In objFolder.SubFolders
    rng.Offset(countRow, 0).Value = objSubFolder.Name
    rng.Offset(countRow, 1).Value = Format(objSubFolder.Size / (1024 ^ 2), "0.00")
    countRow = countRow + 1
  Next
End Sub

FSOのGetFolderメソッドを使用して、指定したフォルダーのFolderオブジェクトを作成します。続いてFolderオブジェクトのSubFoldersオブジェクトを使用して、Foldersコレクション（Folderオブジェクトのコレクション）を作成。その中のFolderオブジェクトについて、Nameプロパティ、Sizeプロパティを使ってフォルダー名とサイズ情報を取得して表示します。

FSOは他にもたくさんの機能があります。以下が詳しいので参考にしてください。

excel-ubara.com

フォルダーのサイズについて

ここで気を付けなければならない点があります。Sizeプロパティを使用してフォルダーのサイズを取得できますが、返ってくる値はバイト単位です。このままだと判りずらいので、メガバイト（MB）に直すのですが、この時に値を100万で割ってはいけません。バイトからメガバイトに変換するには、1024の2乗（つまり2の10乗）で割ります。1キロバイトは1024バイト、1メガバイトは1024キロバイトなのです。

再帰処理

FSOによるフォルダーの処理と言えば、再帰処理によるフォルダー構造の取得が有名です。先の例では、フォルダー下のフォルダーについては対応していません。そこで、プロシージャ「DispFolders」を以下の様に書き換えてみましょう。Functionプロシージャに変更しました。

'フォルダ名とフォルダサイズを取得、表示します（再帰処理でサブフォルダも表示）
Private Function DispFolders(folderPath As String, rng As Range, Optional countRow As Long = 0) As Long
  'ファイルシステムオブジェクト、フォルダオブジェクトを作成します
  Dim objFso As New Scripting.FileSystemObject
  Dim objFolder As Object
  Set objFolder = objFso.GetFolder(folderPath)

  'フォルダ名とフォルダサイズを取得、表示します
  Dim objSubFolder As Object
  For Each objSubFolder In objFolder.SubFolders
    rng.Offset(countRow, 0).Value = folderPath & "\" & objSubFolder.Name
    rng.Offset(countRow, 1).Value = Format(objSubFolder.Size / (1024 ^ 2), "0.00")
    countRow = countRow + 1

    '再帰処理でサブフォルダを調べる
    countRow = DispFolders(objSubFolder.Path, rng, countRow)
  Next
  DispFolders = countRow
End Function

実行すると、サブフォルダーの容量も表示するようになるはずです。