【中級者向け】共有メールボックスの受信メール監視：無限ループを防ぐ堅牢な自動転送システムの設計と実装
チームで共有メールボックスを運用していると、こんな課題に直面しないだろうか？
「顧客からの問い合わせメールを見落とした」
「担当者への振り分け作業に毎日膨大な時間がかかれている」
「転送設定をルール（仕分けルール）で作ったはいいが、条件が複雑化してメンテ不能になった」
Outlookの標準機能である「仕分けルール」は手軽だが、「本文のキーワード解析」「条件に応じた動的な宛先変更」「転送時の無限ループ防止」といった複雑なビジネスロジックには対応できない。
今回は、業務自動化のプロフェッショナルである私たちが、VBAを使って共有メールボックスを監視し、本文のキーワードに応じて担当者へ確実に自動転送する「プロダクション品質のシステム」の構築法を伝授しよう。
生半可なコードでは、共有メールボックス特有の権限問題や、誤作動による「メールの無限ループ地獄」を引き起こす。実務で耐えうる堅牢なアーキテクチャを解説する。
—
1. 共有メールボックス自動化における3つの技術的罠
実装コードに入る前に、なぜ多くの開発者がこの要件で挫折するのか、その「罠」を共有しておく。
1. セッションとフォルダパスの迷子
`Application.Session.GetDefaultFolder` は、あくまで「自分のプライマリメールボックス」を返す。共有メールボックスは明示的にストア（Store）を特定してアクセスしなければならない。
2. 「送信者」の偽装問題
共有メールボックスからメールを転送（`Forward`）する際、明示的に送信元（`SentOnBehalfOfName` や `SendUsingAccount`）を指定しないと、「あなたの個人アドレス」から送信されてしまう。
3. 無限ループ（破滅への道）
転送メールの送受信トリガー設計を誤ると、システムが自分自身にメールを送り続け、数分間で何千通ものスパムを生成する大事故につながる。
これらを完全にクリアする設計こそが、プロの仕事である。
—
2. 全体アーキテクチャと実装コード
以下のコードは、`ThisOutlookSession` モジュールに配置することを前提としている。
共有メールボックスのルート名、監視するフォルダ名、キーワードと転送先の対応表を定数・ロジックとして美しくカプセル化している。
Option Explicit
‘ =================================定数定義=================================
Private Const SHARED_MBX_NAME As String = “support@yourcompany.com” ‘ 共有メールボックスのメールアドレス
Private Const TARGET_FOLDER_NAME As String = “受信トレイ” ‘ 監視対象フォルダ
Private Const PROCESSED_FLAG As String = “AutoForwarded” ‘ 既処理判定用ユーザープロパティ名
‘ ==========================================================================
‘ ————————————————————————–
‘ イベント起点: 新着アイテム受信時
‘ ————————————————————————–
Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
On Error GoTo ErrorHandler
Dim vEntryIDs As Array
Dim i As Long
Dim objItem As Object
‘ NewMailExは複数のEntryIDをカンマ区切りで返すことがあるため分割処理
vEntryIDs = Split(EntryIDCollection, “,”)
For LBound(vEntryIDs) To UBound(vEntryIDs)
Set objItem = Application.Session.GetItemFromID(vEntryIDs(i))
‘ メールアイテムであり、かつ共有メールボックス宛のものか判定
If TypeOf objItem Is MailItem Then
Call ProcessIncomingMail(objItem)
End If
Next i
Exit Sub
ErrorHandler:
‘ ログ出力やエラーハンドリングをここに記述（プロダクションでは必須）
Debug.Print “Error in Application_NewMailEx: ” & Err.Description
End Sub
‘ ————————————————————————–
‘ メイン処理ロジック：判定と転送
‘ ————————————————————————–
Private Sub ProcessIncomingMail(ByVal mail As MailItem)
On Error GoTo ErrorHandler
‘ 1. 【最重要】無限ループ防止策：すでに処理したメールはスルー
If IsAlreadyProcessed(mail) Then Exit Sub
‘ 2. 対象の共有メールボックスからの受信か確認（自作自演の転送メール検知）
If LCase(mail.SenderEmailAddress) = LCase(SHARED_MBX_NAME) Then
‘ 共有メールボックス自身が送信したものは無視（ループの根絶）
Exit Sub
End If
Dim bodyText As String
bodyText = mail.Body
Dim targetRecipient As String
targetRecipient = “”
‘ 3. 本文キーワードによる宛先ルーティングロジック
‘ ※実務ではDBや外部CSV、あるいはDictionaryオブジェクトからの動的取得を推奨
If InStr(1, bodyText, “請求書”, vbTextCompare) > 0 Or InStr(1, bodyText, “入金”, vbTextCompare) > 0 Then
targetRecipient = “accounting-team@yourcompany.com”
ElseIf InStr(1, bodyText, “エラー”, vbTextCompare) > 0 Or InStr(1, bodyText, “バグ”, vbTextCompare) > 0 Then
targetRecipient = “dev-lead@yourcompany.com”
ElseIf InStr(1, bodyText, “解約”, vbTextCompare) > 0 Then
targetRecipient = “retention-manager@yourcompany.com”
End If
‘ 4. 該当キーワードがあった場合のみ転送処理を実行
If targetRecipient <> “” Then
ExecuteForward mail, targetRecipient
‘ 既処理マークを付与（二重処理およびループの完全防止）
Call MarkAsProcessed(mail)
End If
Exit Sub
ErrorHandler:
MsgBox “ProcessIncomingMailでエラーが発生しました: ” & Err.Description, vbCritical
End Sub
‘ ————————————————————————–
‘ 転送実行コア関数
‘ ————————————————————————–
Private Sub ExecuteForward(ByVal sourceMail As MailItem, ByVal recipientEmail As String)
Dim fwdMail As MailItem
Dim sharedAccount As Account
Dim i As Long
‘ 転送アイテムの作成
Set fwdMail = sourceMail.Forward
With fwdMail
.Recipients.Add recipientEmail
.Subject = “[自動転送] ” & sourceMail.Subject
‘ 共有メールボックスのアカウントオブジェクトを特定して送信元に設定
‘ ※これを行わないと、個人のアカウントから送信されてしまう
For i = 1 To Application.Session.Accounts.Count
If LCase(Application.Session.Accounts(i).SmtpAddress) = LCase(SHARED_MBX_NAME) Then
Set .SendUsingAccount = Application.Session.Accounts(i)
Exit For
End If
Next i
‘ 送信（ドラッグ＆ドロップや確認画面を出したくない場合は .Send、確認したい場合は .Display）
.Send
End With
Set fwdMail = Nothing
End Sub
‘ ————————————————————————–
‘ 既処理フラグの管理（UserPropertiesの活用）
‘ ————————————————————————–
Private Function IsAlreadyProcessed(ByVal mail As MailItem) As Boolean
Dim prop As UserProperty
Set prop = mail.UserProperties.Find(PROCESSED_FLAG)
If prop Is Nothing Then
IsAlreadyProcessed = False
Else
IsAlreadyProcessed = True
End If
End Function
Private Sub MarkAsProcessed(ByVal mail As MailItem)
Dim prop As UserProperty
Set prop = mail.UserProperties.Add(PROCESSED_FLAG, olText)
prop.Value = “True”
mail.Save
End Sub
—
3. コードのキモ：なぜこの設計が「プロフェッショナル」なのか？
① `UserProperties` による確実なステータス管理
フラグとして既読（`UnRead = False`）やカテゴリを使う開発者がいるが、これらはユーザーの誤操作や他のアドインによって容易に変更・上書きされてしまう。
Outlookのメールオブジェクトが持つ隠しメタデータ `UserProperties` を利用することで、人間には見えない堅牢な処理済みフラグをメール本体に焼き付けることができる。これにより、Outlookを再起動しても判定が維持される。
② 二重の無限ループ防止フィルター
無限ループ事故のほとんどは「自分が送った転送メールを、再び監視トリガーが拾ってしまう」ことで発生する。
本コードでは以下の2段構えでこれを完全に封じている。
1. `UserProperties` による既処理判定（同じメールを二度処理させない）
2. 送信者アドレス（`SenderEmailAddress`）が共有メールボックス自身である場合の早期リターン（`Exit Sub`）
③ 共有メールボックスからの「正しい」送信権限の掌握
Outlook VBAで複数アカウントを扱う際の最大の罠が `SendUsingAccount` の未設定だ。
セッション内の全アカウントを走査し、共有メールボックスのアドレスと一致するものを `SendUsingAccount` にバインドすることで、宛先に「誰が送ったか」を正しく共有メールボックス名義で通知できる。
—
4. 運用・拡張にあたってのアーキテクチャ的提言（外部連携）
今回のコードではキーワード判定をコード内の `If…ElseIf` で記述したが、実運用でキーワードが50個を超えたり、担当者が頻繁に変更される場合、コードを書き換えるのは保守性の観点から悪手である。
- データベース/CSV連携への昇華
本番環境では、キーワードと宛先のマッピングを外部の共有CSVファイル、またはSQLite等の軽量DBに切り出し、`Application_NewMailEx` が走るたびに読み込む（あるいはDictionaryにキャッシュする）設計にブラッシュアップしてほしい。
- エラーハンドリングとロギング
プロダクション環境では、`On Error Resume Next` のような愚行は避け、エラー発生時にはTeamsやSlackのIncoming WebhookへJSONを飛ばすアラート機能を組み込んでおくべきだ。
—
総括
Outlook VBAは、正しく設計すれば「数百万規模の市販RPAツール」に匹敵する軽量かつ強力な自動化エンジンに変貌する。
今回解説した「権限の考慮」「無限ループの物理的遮断」「メタデータによる状態管理」は、メール自動化における黄金律である。
あなたのチームの共有メールボックスを、今すぐモダンでスマートな自動化ハブへと進化させてほしい。
