Option Explicit
Sub Main()
'//一覧をクリア'
Range("A8", Range("A8").SpecialCells(xlLastCell)).Clear
Call 一括チェック
MsgBox "完了"
End Sub
'#######################################################'
Sub 一括チェック()
Dim wbSheet As Worksheet
Dim FSO As Object
Dim chkFolderPath As String
Dim dataRow As Long
Dim subFolCnt As Long
Dim minFolSize As Long
'//書き込むシートを設定'
Set wbSheet = ThisWorkbook.Sheets("フォルダ一覧")
'//チェックしたいフォルダのパスを記述したセル'
chkFolderPath = wbSheet.Range("A5")
'//FSOのインスタンス化'
Set FSO = CreateObject("Scripting.FileSystemObject")
'//一覧の開始行'
dataRow = 8
'//階層数'
subFolCnt = wbSheet.Range("D4")
'//最小サイズ'
minFolSize = wbSheet.Range("D5")
'//指定したフォルダを調べる'
Call chkFSize(FSO, wbSheet, dataRow, chkFolderPath, 0, subFolCnt, minFolSize)
Set FSO = Nothing
End Sub
'#######################################################'
Sub chkFSize(ByRef FSO As FileSystemObject, ByRef wbSheet As Worksheet, ByRef dataRow As Long, _
ByVal chkFolderPath As String, ByRef cnt2 As Long, ByVal subFolCnt As Long, ByVal minFolSize As Long)
Dim objFolder As Folder
Dim eachFolder As Folder
Dim subFolder As Folders
Dim FolderSizeMB As Long
Dim cnt As Long
cnt2 = cnt2 + 1
'//検索フォルダのオブジェクト'
Set objFolder = FSO.GetFolder(chkFolderPath)
'//サブフォルダのオブジェクト'
Set subFolder = objFolder.SubFolders
For Each eachFolder In subFolder
'フォルダーサイズチェック'
FolderSizeMB = WorksheetFunction.RoundDown(eachFolder.Size / 1024 / 1024, 0)
If FolderSizeMB >= minFolSize Then '所定のサイズ以下の場合は一覧に表示しない'
'//通番の設定'
wbSheet.Cells(dataRow, 1) = dataRow - 7
'//フォルダ名'
wbSheet.Cells(dataRow, 2) = chkFolderPath & "\" & eachFolder.Name
'"
'//フォルダの容量（MB）、小数点以下なし'
wbSheet.Cells(dataRow, 3) = FolderSizeMB
'//フォルダの容量（GB）、小数点以下2桁まで表示'
wbSheet.Cells(dataRow, 4) = WorksheetFunction.RoundDown(eachFolder.Size / 1024 / 1024 / 1024, 2)
dataRow = dataRow + 1
If cnt2 >= subFolCnt And subFolCnt <> 0 Then
'//次のフォルダへ'
Else
'//サブフォルダのサイズも調べる'
Call chkFSize(FSO, wbSheet, dataRow, chkFolderPath & "\" & eachFolder.Name, cnt2, subFolCnt, minFolSize)
cnt = cnt + 1
cnt2 = 0
End If
Else
'何もしない'
End If
Next
End Sub
