フォルダとサブフォルダの一覧とフォルダサイズを取得するマクロ

暑い夏がいつまで続くのかと嫌になっていましたが、
ようやく秋の気配で元気が出てきました。
お掃除のシーズンになりまして、フォルダも整理しなくちゃいけなくなりました。

最近は容量に余裕があるので、整理は後回しになって、どんどん巨大化していく傾向にあります。
必要なものだけにしてくれるといいのですが、整理する時間がない…

1個ずつフォルダのサイズを見るのは大変なので、
マクロを作成しました。

Sheetの構成は
①フォルダ名とサイズ取得
②サブフォルダ名とサイズ取得
の2つを作成してください。
ツール⇒参照設定からMicrosoft Scripting Runtimeにチェックを入れてください。

マクロbookをサイズを拾いたいフォルダと同じ位置に置いてください。
①ボタン実行で
マクロbookのあるフォルダ内にあるフォルダの一覧とサイズを取得します。
出力先シートは「①フォルダ名とサイズ取得」です。

②ボタン実行で
①ボタン実行で取得したフォルダのサブフォルダの一覧とサイズを取得します。
出力先シートは「②サブフォルダ名とサイズ取得」です。


♪自己責任で使ってください。♪
ここから下がコードです。
Sub ①ボタン実行()
Application.Run "①フォルダの一覧とフォルダサイズを取得するマクロ"
Application.Run "①バイト変換"
End Sub
Sub ②ボタン実行()
Application.Run "②サブフォルダ名とサイズを取得するマクロ"
Application.Run "②バイト変換"
End Sub
Sub ①フォルダの一覧とフォルダサイズを取得するマクロ()
'ツール⇒参照設定からMicrosoft Scripting Runtimeにチェックを入れる。
'このマクロファイルを一覧を取得したいフォルダに保存する。
'このマクロファイルと同じ階層にあるフォルダの名前を一覧で表示する。
'2018/9/14-win7-64_office2010

Dim myFso As Scripting.FileSystemObject
Dim myFolders As Scripting.Folders
Dim myFolder As Scripting.Folder
Dim Cnt As Long
Dim CntMax As Long
ThisWorkbook.Sheets("①フォルダ名とサイズ取得").Select
Application.ScreenUpdating = False
Range("A:A").Clear 'a列初期化
CntMax = Cells(Rows.Count, 1).End(xlUp).Row


Cnt = 2
Set myFso = New Scripting.FileSystemObject
Set myFolders = myFso.GetFolder(ThisWorkbook.Path).SubFolders
For Each myFolder In myFolders
Sheets("①フォルダ名とサイズ取得").Cells(Cnt, 1).Value = myFolder.Name
Sheets("①フォルダ名とサイズ取得").Cells(Cnt, 2).Value = myFolder.Size
Cnt = Cnt + 1
Next
Columns("A:A").EntireColumn.AutoFit

Set myFolders = Nothing 'オブジェクトの解放
Set myFso = Nothing
Sheets("①フォルダ名とサイズ取得").Range("a1").Value = "フォルダ名"
Sheets("①フォルダ名とサイズ取得").Range("b1").Value = "フォルダサイズ"
Application.ScreenUpdating = True

Range("A1").Select
End Sub
Sub ①バイト変換()
Dim Atai As String
Dim Cnt As Long
Dim CntMax As Long
ThisWorkbook.Sheets("①フォルダ名とサイズ取得").Select
Range("C1").Value = "フォルダサイズ単位KB"
Range("D1").Value = "フォルダサイズ単位MB"
Range("E1").Value = "フォルダサイズ単位GB"
CntMax = Cells(Rows.Count, 1).End(xlUp).Row
Dim AtaiB As Double
For Cnt = 2 To CntMax Step 1
AtaiB = Cells(Cnt, 2).Value
Cells(Cnt, 3).Value = AtaiB / 1024
Cells(Cnt, 4).Value = AtaiB / 1048576
Cells(Cnt, 5).Value = AtaiB / 1073741824
Next Cnt
Columns("A:E").EntireColumn.AutoFit
Range(Cells(2, 3), Cells(CntMax, 5)).NumberFormatLocal = "0.0_ "

End Sub
Sub ②サブフォルダ名とサイズを取得するマクロ()
'ツール⇒参照設定からMicrosoft Scripting Runtimeにチェックを入れる。
'①で取得したフォルダのサブフォルダを取得する。
Dim myFso As Scripting.FileSystemObject
Dim myFolders As Scripting.Folders
Dim myFolder As Scripting.Folder
Dim Atai As String
Dim Cnt As Long
Dim Cnt2 As Long

Dim CntMax As Long
Dim CntMax2 As Long
Dim FolCount As Long
Application.ScreenUpdating = False
Sheets("②サブフォルダ名とサイズ取得").Range("a:b").Clear 'ab列初期化

Cnt = 2
CntMax = Sheets("①フォルダ名とサイズ取得").Cells(Rows.Count, 1).End(xlUp).Row
For Cnt = 2 To CntMax Step 1
Atai = Sheets("①フォルダ名とサイズ取得").Cells(Cnt, 1).Value
Set myFso = New Scripting.FileSystemObject
'Ataiのフォルダのサブフォルダを取得
Set myFolders = myFso.GetFolder(ThisWorkbook.Path & "\" & Atai).SubFolders
FolCount = myFolders.Count

'Ataiのフォルダにサブフォルダがない時の処理
If FolCount = 0 Then

CntMax2 = Sheets("②サブフォルダ名とサイズ取得").Cells(Rows.Count, 1).End(xlUp).Row
Sheets("②サブフォルダ名とサイズ取得").Cells(CntMax2 + 1, 1).Value = Atai
Sheets("②サブフォルダ名とサイズ取得").Cells(CntMax2 + 1, 2).Value = "サブフォルダなし"

Else 'Ataiのフォルダにサブフォルダがある時の処理
For Each myFolder In myFolders
CntMax2 = Sheets("②サブフォルダ名とサイズ取得").Cells(Rows.Count, 1).End(xlUp).Row
Sheets("②サブフォルダ名とサイズ取得").Cells(CntMax2 + 1, 1).Value = Atai
Sheets("②サブフォルダ名とサイズ取得").Cells(CntMax2 + 1, 2).Value = myFolder.Name
Sheets("②サブフォルダ名とサイズ取得").Cells(CntMax2 + 1, 3).Value = myFolder.Size
Next
End If
Next
Sheets("②サブフォルダ名とサイズ取得").Columns("A:C").EntireColumn.AutoFit
Range("A1").Select
Set myFolders = Nothing 'オブジェクトの解放
Set myFso = Nothing
Sheets("②サブフォルダ名とサイズ取得").Range("a1").Value = "フォルダ名"
Sheets("②サブフォルダ名とサイズ取得").Range("b1").Value = "サブフォルダ名"
Sheets("②サブフォルダ名とサイズ取得").Range("c1").Value = "サブフォルダサイズ"


Application.ScreenUpdating = True
End Sub


Sub ②バイト変換()
Dim Atai As String
Dim Cnt As Long
Dim CntMax As Long
Sheets("②サブフォルダ名とサイズ取得").Select
Range("d1").Value = "サブフォルダサイズ単位KB"
Range("e1").Value = "サブフォルダサイズ単位MB"
Range("f1").Value = "サブフォルダサイズ単位GB"
CntMax = Cells(Rows.Count, 1).End(xlUp).Row
Dim AtaiB As Double
For Cnt = 2 To CntMax Step 1
AtaiB = Cells(Cnt, 3).Value
Cells(Cnt, 4).Value = AtaiB / 1024
Cells(Cnt, 5).Value = AtaiB / 1048576
Cells(Cnt, 6).Value = AtaiB / 1073741824
Next Cnt
Columns("A:F").EntireColumn.AutoFit
Range(Cells(2, 4), Cells(CntMax, 6)).NumberFormatLocal = "0.0_ "

End Sub

ブログ気持玉

クリックして気持ちを伝えよう!

ログインしてクリックすれば、自分のブログへのリンクが付きます。

→ログインへ

なるほど(納得、参考になった、ヘー)
驚いた
面白い
ナイス
ガッツ(がんばれ!)
かわいい

気持玉数 : 0

この記事へのコメント

この記事へのトラックバック