VBA ログ管理テンプレート（一定期間ごとに自動ZIP圧縮：月初実行版）
Excel VBAには「タスクスケジューラ」のような常駐機能はありませんが、WorkbookイベントやOnTimeメソッドを使うことで「定期的に処理を実行」できます。ここでは「月初にアーカイブフォルダ内のログをZIP圧縮する」サンプルを紹介します。
サンプルコード（Workbookイベント＋OnTime）
Option Explicit
'=== 月初にZIP圧縮をスケジュール ===
Private Sub Workbook_Open()
' ブックを開いたときに次の月初を予約
ScheduleZipArchive
End Sub
Sub ScheduleZipArchive()
Dim nextRun As Date
' 次の月初（1日午前9時）を計算
nextRun = DateSerial(Year(Date), Month(Date) + 1, 1) + TimeSerial(9, 0, 0)
' OnTimeで予約
Application.OnTime nextRun, "ZipArchiveLogs"
End Sub
'=== ZIP圧縮処理（前回作成したものを利用） ===
Sub ZipArchiveLogs()
Dim fso As Object
Dim folder As Object
Dim file As Object
Dim archivePath As String
Dim zipFilePath As String
archivePath = ThisWorkbook.Path & "\Archive"
zipFilePath = ThisWorkbook.Path & "\ArchiveLogs_" & Format(Date, "yyyymm") & ".zip"
Set fso = CreateObject("Scripting.FileSystemObject")
' アーカイブフォルダが存在しない場合は終了
If Not fso.FolderExists(archivePath) Then Exit Sub
' 既存ZIPがあれば削除
If fso.FileExists(zipFilePath) Then fso.DeleteFile zipFilePath
' 空ZIP作成
Open zipFilePath For Output As #1
Print #1, "PK" & Chr(5) & Chr(6) & String(18, vbNullChar)
Close #1
' ShellでZIPにファイルをコピー
Dim sh As Object, zipFolder As Object
Set sh = CreateObject("Shell.Application")
Set zipFolder = sh.NameSpace(zipFilePath)
Set folder = fso.GetFolder(archivePath)
For Each file In folder.Files
zipFolder.CopyHere file.Path
Application.Wait (Now + TimeValue("0:00:01")) ' コピー待機
Next file
MsgBox "月初のZIP圧縮が完了しました: " & zipFilePath, vbInformation
' 次回の月初も予約
ScheduleZipArchive
End Sub
この仕組みの流れ
- Workbook_Openイベント
→ ブックを開いたときに「次の月初」を予約。 - Application.OnTime
→ 指定日時にZipArchiveLogsを自動実行。 - ZipArchiveLogs
→ アーカイブフォルダ内のログをZIP圧縮。
→ 処理後に次の月初も再予約。
実務でのメリット
- 完全自動化 → 月初にログをまとめてZIP化
- ファイル名に年月を付与 →
ArchiveLogs_202511.zipのように管理しやすい - 継続運用 → 毎月自動で繰り返し実行される
✅ まとめ
- Workbook_Openで「次の月初」を予約
- OnTimeで自動実行
- ZipArchiveLogsでアーカイブフォルダをZIP化
