VBAツール：【Excel】フォルダ容量一括チェックツール
◆フォルダ容量一括チェックツール
Excelの見た目はこんな感じです。
【使い方】
(1)「チェックしたいフォルダ」の下の「A5」セルにフォルダのパスを貼り付けます。
(2)「階層数」に調べたい階層の数字を入れます。
「1」なら指定したフォルダの一つ下までです。「空欄」なら全てです。
「空欄」でサーバなど数千から数万はフォルダがありそうなところでやるといつまでたっても終わらない場合があるので注意です。
(3)「最小サイズ(MB)」に何MB以上のフォルダを対象にするか指定します。
入力されたサイズ(MB)以上のフォルダを一覧に表示します。
(4)「チェック開始」をクリックします。
(5)処理が終わると「完了」とでます。8行目以下にデータが貼り付けられます。
◆ツールのコード
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 |
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 |
