フォルダの容量監視（ファイル数）

指定したフォルダの容量を監視します。ネットワークドライブなどの共用の場合、無尽蔵に増えることがあり、定期的監視が必要となることもあります。
フォルダを右クリックして値を入力して、保存を自動で行えるようにしました。

Excelマクロを実行するファイルのシートに設定情報を追加します。ソースコードの中の「設定を読み込む」個所で使用します。

Excelマクロを実行するファイル
・監視フォルダは、監視対象のフォルダ名を指定します。
・出力ファイルは、Excelマクロを実行するファイルとは別けて作成する形をにしています。

出力ファイル (FolderInfo.xlsx) 実行する度に下に追加されていきます。

以下の関数を使用していますので、リンクから関数をコピーします。
・ファイルの有無を確認する IsFileExists()
・フォルダのプロパティ(サイズとファイルの数)を取得 GetFolderCount(), GetFolderSize()
・サブフォルダまで一括作成 CreateSubFolder()
・最終行取得（空白まで） GetBlankRow()

Option Explicit

Type FolderInfo
	FilesCount As Long	' ファイルの件数
	FolderCount As Long	' フォルダの件数
End Type

Sub GetFolderSize_Click()
	Dim fd As FolderInfo

	Dim target_folder As String
	Dim output_file As String

	Dim ws_this As Worksheet
	Dim wb As Workbook
	Dim ws As Worksheet

	Dim sz As LongLong
	Dim last_row As Long


	On Error GoTo ErrProc

	Set ws_this = ThisWorkbook.Sheets(1)

	' 設定を読み込む
	target_folder = ws_this.Range("B1")
	output_file = ws_this.Range("B2")


	' 指定したフォルダのファイルとフォルダの数を取得
	GetFolderCount target_folder, fd
	' 指定したフォルダのサイズを取得
	sz = GetFolderSize(target_folder)


	If IsFileExists(output_file) = True Then   ' ファイルの有無を確認
		Set wb = Workbooks.Open(output_file)   ' ブックを開く
	Else
		' ファイルが無い場合、ブックを作成
		Set wb = Workbooks.Add
	End If

	' 出力先はシートの1に
	Set ws = wb.Sheets(1)
	With ws
		' 最終行の取得
		last_row = GetBlankRow(ws)
		If last_row = 0 Then
			' 最終行が0の場合は、データが無いのでタイトルを付ける
			.Range("A1") = "Date"
			.Range("B1") = "Time"
			.Range("C1") = "Size"
			.Range("D1") = "Files Count"
			.Range("E1") = "Folder Count"
			last_row = 2
		Else
			last_row = last_row + 1
		End If

		' データを設定
		.Range("A" & last_row) = Date
		.Range("B" & last_row) = Time
		.Range("C" & last_row) = sz
		.Range("D" & last_row) = fd.FilesCount
		.Range("E" & last_row) = fd.FolderCount

		' スタイルを変更
		.Columns("A:E").EntireColumn.AutoFit
		.Columns("B:B").NumberFormatLocal = "[$-x-systime]h:mm:ss AM/PM"
		.Columns("C:E").Style = "Comma [0]"
		.Range("A1").Select	' A1を選択しておく
	End With

	If last_row = 2 Then
		If CreateSubFolder(output_file, False) = True Then
			' 2の場合は、新規保存
			wb.SaveAs filename:=output_file
		End If
	Else
		' 上書き保存
		wb.Save
	End If

	' ブックを閉じる
	wb.Close
	Exit Sub

' エラー発生時の処理
ErrProc:
	Debug.Print "エラー番号:" & Err.Number & ", エラーの種類:" & Err.Description
End Sub