VBA拡張版：複数ブックをまとめてZIP圧縮してメール添付
これまで「複数ブックをまとめてPDF化」する方法を紹介しました。今回はさらに拡張して、複数ブックをZIP圧縮してメール添付するテンプレートです。これにより、元ファイルをそのまま配信でき、受信者が必要に応じて展開して利用できます。
手順の流れ
- 対象ブックを指定（例：Sales.xlsx、Error.xlsx、Stock.xlsx）
- ZIPファイルを作成（Windows標準の圧縮フォルダ機能を利用）
- 対象ファイルをZIPにコピー
- CDO.Messageでメール送信
- ZIPファイルを添付
- HTML本文に説明を記載
サンプルコード
Option Explicit
Sub SendMultiWorkbookZipMail()
Dim fso As Object, sh As Object, zipFolder As Object
Dim zipFilePath As String, targetPath As String
'=== ZIPファイルパス ===
zipFilePath = ThisWorkbook.Path & "\multi_workbook_report.zip"
'=== 対象ファイルパス ===
Dim filesToZip As Variant
filesToZip = Array( _
ThisWorkbook.Path & "\Sales.xlsx", _
ThisWorkbook.Path & "\Error.xlsx", _
ThisWorkbook.Path & "\Stock.xlsx")
Set fso = CreateObject("Scripting.FileSystemObject")
' 既存ZIPがあれば削除
If fso.FileExists(zipFilePath) Then fso.DeleteFile zipFilePath
' 空ZIPファイルを作成（Windows圧縮フォルダ）
Open zipFilePath For Output As #1
Print #1, "PK" & Chr(5) & Chr(6) & String(18, vbNullChar)
Close #1
' ShellでZIPにファイルをコピー
Set sh = CreateObject("Shell.Application")
Set zipFolder = sh.NameSpace(zipFilePath)
Dim i As Integer
For i = LBound(filesToZip) To UBound(filesToZip)
If fso.FileExists(filesToZip(i)) Then
zipFolder.CopyHere filesToZip(i)
' コピーが完了するまで待機（簡易的に1秒）
Application.Wait (Now + TimeValue("0:00:01"))
End If
Next i
'=== メール送信 ===
Dim objMsg As Object, objConf As Object
Set objMsg = CreateObject("CDO.Message")
Set objConf = CreateObject("CDO.Configuration")
' SMTP設定（例：Office365）
With objConf.Fields
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.office365.com"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 587
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "your_account@domain.com"
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "your_password"
.Update
End With
With objMsg
Set .Configuration = objConf
.From = "your_account@domain.com"
.To = "admin@domain.com"
.Subject = "【VBAタスク通知】複数ブックレポート（ZIP添付）"
' ZIPファイルを添付
.AddAttachment zipFilePath
' HTML本文
.HTMLBody = _
"<html><body>" & _
"<h2 style='color:blue;'>📦 複数ブックレポート</h2>" & _
"<p>Sales.xlsx・Error.xlsx・Stock.xlsx をまとめてZIP圧縮しました。</p>" & _
"<p>添付ファイルをご確認ください。</p>" & _
"</body></html>"
.Send
End With
MsgBox "複数ブックをZIP圧縮して添付したメールを送信しました", vbInformation
End Sub
この拡張版のポイント
- 複数ブックをZIP圧縮 → 元ファイルをそのまま配信可能
- Shell.ApplicationでZIP操作 → Windows標準機能を利用
- CDO.Messageで添付送信 → ZIPファイルをメールに添付
実務でのメリット
- 元ファイルを保持 → 受信者が展開してそのまま利用可能
- 容量削減 → 複数ファイルをまとめて軽量化
- 完全自動化可能 → タスクスケジューラと組み合わせれば「毎月のZIPレポート」を自動送信
✅ まとめ
- 複数ブックをZIP圧縮してメール添付
- 元ファイルをそのまま配信できるので柔軟性が高い
- 自動化すれば「定期的なファイル配信システム」が完成
