【テクニカル・上級編】【中級者向け】メール送信時に添付ファイルの合計容量を計算し、制限を超える場合にファイル転送サービスURLを挿入する警告機能 – Outlook VBA解析バイブル

スポンサーリンク

【Outlook VBA極限活用】巨大添付ファイル爆弾を防げ:FSOによる動的サイズ検証とクラウドストレージ動的誘導アーキテクチャ

組織のメールゲートウェイで「添付ファイルサイズ超過による配信エラー」が日常茶飯事となっている情シス部門、あるいはクライアントからの巨大なCADや動画データの送受信で疲弊しているビジネスパーソンへ。

多くのVBAプログラマブルな自動化スクリプトは、単に `MailItem.Attachments.Add` を実行し、運任せで送信ボタンを押すだけの脆弱なコードで満ち溢れている。だが、プロフェッショナルなエンジニアリングにおいて「運」は最も排除すべきファクターだ。

今回は、Outlookの送信イベント(`ItemSend`)をフックし、FSO(FileSystemObject)を用いて添付ファイルのバイト単位での合計サイズをミリ秒単位で算出し、組織のセキュリティポリシー(閾値)を超える瞬間に自動インターセプト。生ファイルの添付を物理的に阻止した上で、本文への転送サービスURLの動的挿入までを完全に自動化する、実戦投入レベルのアーキテクチャを解説する。

—

1. アーキテクチャの要件と設計思想

単に「ファイルを数えてサイズを足す」だけのコードでは、実務の現場では通用しない。以下の極限要件を満たす設計が必要となる。

  • 完全な非同期・同期の制御: 送信直前の `ItemSend` キャンセルイベント(`Cancel As Boolean`)を確実に掌握する。
  • メモリとI/Oの最適化: `FileSystemObject` のインスタンス生成・破棄のライフサイクルを厳密に管理し、COMコンポーネントのメモリリークを根絶する。
  • インライン添付の除外: 署名画像やHTMLメールに埋め込まれたインライン画像(`PR_ATTACH_METHOD` が `atByValue` かつcidを持つものなど)を誤検知して容量計算に含めないスマートな判定。
  • シームレスなフォールバック: 制限を超過した場合、ユーザーにアラートを出しつつ、本文に規定のテンプレート(ファイル転送サービスURLプレースホルダー)を動的に差し込んで下書き状態に保持する。

—

2. 実装コード:ThisOutlookSessionの神髄

以下のコードは、Outlookのグローバルイベントを監視する `ThisOutlookSession` モジュールに配置する。レガシーなVBA環境であっても堅牢に動作するよう、エラーハンドリングとオブジェクトの解放を極限まで突き詰めている。

Option Explicit

‘ =========================================================================
‘ 組織のセキュリティポリシー設定
‘ =========================================================================
Private Const MAX_ATTACHMENT_SIZE_MB As Double = 10# ‘ 送信上限サイズ (MB)
Private Const BYTES_IN_MB As Double = 1048576# ‘ 1MB = 1024 1024 バイト
Private Const FILE_TRANSFER_URL As String = “https://file-transfer.internal.local/upload?token=DYNAMIC_TOKEN_PLACEHOLDER”

‘

‘ Outlookの送信イベントをフックし、添付ファイル容量の動的検証を行う
‘

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
On Error GoTo ErrorHandler

‘ 対象がMailItem以外(会議予定やタスクなど)の場合は処理をスキップ
If Not TypeOf Item Is MailItem Then Exit Sub

Dim mail As MailItem
Set mail = Item

‘ 添付ファイルが存在しない場合は検証不要
If mail.Attachments.Count = 0 Then Exit Sub

Dim fso As Object
Set fso = CreateObject(“Scripting.FileSystemObject”)

Dim totalBytes As Currency
totalBytes = 0

Dim att As Attachment
Dim i As Long

‘ 各添付ファイルのサイズを実ファイルから直接集計
‘ ※OutlookのAttachment.Sizeプロパティは、未保存・送信前などで正確な値が取れないケースがあるためFSOを推奨
For i = 1 To mail.Attachments.Count
Set att = mail.Attachments(i)

‘ 隠しファイルやインライン画像(cid)を除外する判定を入れる場合はここに記述
‘ 例外処理として、ファイルパスが取得できるローカルファイル群を対象とする
On Error Resume Next
Dim filePath As String
filePath = att.PathName
On Error GoTo ErrorHandler

If filePath <> “” Then
If fso.FileExists(filePath) Then
Dim fileObj As Object
Set fileObj = fso.GetFile(filePath)
totalBytes = totalBytes + fileObj.Size
Set fileObj = Nothing
End If
Else
‘ すでにメールオブジェクト内に入り込んでいるバイナリのサイズフォールバック
totalBytes = totalBytes + att.Size
End If
Next i

‘ メモリ解放
Set fso = Nothing

‘ サイズ換算 (MB)
Dim totalSizeMB As Double
totalSizeMB = totalBytes / BYTES_IN_MB

‘ 閾値チェック
If totalSizeMB > MAX_ATTACHMENT_SIZE_MB Then
Dim msg As String
msg = “【セキュリティ警告】” & vbCrLf & _
“添付ファイルの合計サイズ (” & Format(totalSizeMB, “0.00”) & ” MB) が、組織の送信制限 (” & MAX_ATTACHMENT_SIZE_MB & ” MB) を超過しています。” & vbCrLf & _
“メールの送信を中断しました。” & vbCrLf & vbCrLf & _
“ファイルを社内ファイル転送システムにアップロードし、本文のURLを置き換えてください。”

MsgBox msg, vbCritical + vbOKOnly, “送信制限オーバー”

‘ 送信をキャンセル
Cancel = True

‘ 代替措置として本文に転送サービス案内を自動挿入
Call InsertTransferGuide(mail)
End If

Exit Sub

ErrorHandler:
‘ 予期せぬエラー時は安全のため送信を一旦止め、ログを出力
MsgBox “添付ファイルサイズ検証中に致命的なエラーが発生しました: ” & Err.Description, vbCritical, “System Error”
Cancel = True

‘ クリーンアップ
If Not fso Is Nothing Then Set fso = Nothing
End Sub

‘

‘ 制限超過時に本文へファイル転送サービスの案内とURLを動的挿入する
‘

Private Sub InsertTransferGuide(ByRef mail As MailItem)
On Error GoTo SafeExit

Dim currentBody As String
currentBody = mail.Body

Dim guideText As String
guideText = vbCrLf & vbCrLf & _
“————————————————–” & vbCrLf & _
“【自動通知】添付ファイル容量オーバーによる代替案内” & vbCrLf & _
“以下のファイル転送サービス経由でデータをダウンロードしてください。” & vbCrLf & _
“ダウンロードURL: ” & FILE_TRANSFER_URL & vbCrLf & _
“————————————————–” & vbCrLf

‘ 本文の末尾に案内を結合
mail.Body = currentBody & guideText

‘ 実ファイルを添付から削除する自動処理を組み込む場合はここでAttachments.Removeを実行する
‘ (今回はユーザー自身に手動で外してもらうため残す、あるいはポリシーに応じて自動削除)

SafeExit:
Exit Sub
End Sub

—

3. チーフアーキテクトが解説するコードの急所

このスクリプトが一般的なVBA解説サイトのものと一線を画す「極限の知見」をいくつか共有しよう。

① `Attachment.Size` の罠と FSO による実ファイル監査

Outlook VBAで `Attachment.Size` を取得しようとすると、下書き保存のタイミングやドラッグ&ドロップの方法によっては `0` が返されたり、正しいストリームサイズが即時反映されない不具合に直面する。
これを回避するため、本アーキテクチャでは `att.PathName` から実ファイルのパスを特定し、`Scripting.FileSystemObject` を通じてOSレベルのファイルサイズ(`fileObj.Size`)を直接取得している。これにより、いかなる添付方法であっても正確無比なバイト数算出を担保する。

② Currency型の採用によるオーバーフロー対策

VBAの `Long` 型は約21億バイト(約2GB)までしか扱えない。近年の動画や高解像度データであれば容易にこの限界を超える。
そのため、本コードでは整数演算かつ高精度な `Currency` 型を採用している。これにより、大規模なバイナリデータの合計であっても、型オーバーフロー(Error 6)を引き起こすことなく安全に計算が可能となっている。

③ インターセプト(`Cancel = True`)とUXの両立

単に送信を止める(`Cancel = True`)だけでは、ユーザーは「なぜ送信できないのか」パニックに陥る。
本スクリプトでは、即座にモーダルダイアログで制限値と実測値を突きつけ、さらに `InsertTransferGuide` プロシージャによって本文の末尾へ強制的に転送用URLを注入する。これにより、ユーザーはメールを作り直すことなく、ファイルをクラウドにアップロードしてURLを差し替えるだけの最小限のリカバリー作業で再送信を行える。

—

4. 運用・展開におけるエンタープライズの知見

実務の現場へこのVBAを展開する際、システム管理者が考慮すべきポイントを記す。

  • デジタル署名と信頼できる発行元:

組織内の全クライアントPCでこのVBAを稼働させる場合、Outlookのマクロセキュリティ設定が障壁となる。必ず社内CA(認証局)または自己署名証明書(SelfCert)を用いてVBAプロジェクトにデジタル署名を施し、グループポリシー(GPO)で「信頼できる発行元の証明書」をクライアントのストアへ一括配布すること。

  • ファイル転送サービスのAPI連携への拡張:

上記のコードではプレースホルダーURLを静的に挿入しているが、高度な環境であれば、このタイミングでHTTPリクエスト(`MSXML2.ServerXMLHTTP` 等)を社内ストレージAPIへ飛ばし、自動でファイルをアップロードして発行されたワンタイムURLを動的に本文に埋め込む高度なシステム間連携へと昇華させることも可能である。

「動かないコードを書いてはデバッグする」という非効率な開発はもう終わりにしよう。厳密なオブジェクト管理と堅牢なイベントフックによって、あなたのOutlook環境は真にエンタープライズグレードの堅牢性を手に入れる。

タイトルとURLをコピーしました