1. はじめに：なぜあなたのマルチアカウント自動化はバグを生むのか
マルチアカウント環境でのOutlook自動化において、多くの開発者が最初にぶち当たる壁があります。
それが「宛先によって送信元メールアドレスを自動で切り替えたいが、意図したアカウントから送信されない」というトラブルです。
現場のコードでよく見かけるのが、単に `MailItem.SentOnBehalfOfName` プロパティに送信元アドレスを文字列として代入する手法です。もしあなたがこの実装をしているなら、そのコードは遅かれ早かれプロダクション環境で事故を起こします。
`SentOnBehalfOfName` は「代理送信（代理差出人）」の権限がExchangeサーバー上で与えられている場合にのみ機能するプロパティであり、Outlookに登録された複数アカウント（POP3/IMAP/Exchange）の送信パイプ（Transport Pipe）そのものを切り替えるプロパティではないからです。
権限がない状態で `SentOnBehalfOfName` を指定すると、エラーを出さずに黙ってプライマリ（デフォルト）アカウントから送信されるか、最悪の場合、配信不能レポート（NDR）が返信されて業務事故につながります。
本記事では、複数アカウント環境における「送信元動的判定ロジック」の極意を伝授します。
単なるサンプルコードの提示にとどまらず、なぜこのオブジェクトを使うべきなのかというアーキテクチャの背景から、スケールに耐えうる堅牢なVBA実装までを徹底解説します。
—
2. アーキテクチャの根幹：`SendUsingAccount` と `SentOnBehalfOfName` の決定的な違い
動的切り替えロジックを設計する前に、Outlook Object Modelにおける「送信パイプ」の構造を正しく理解する必要があります。
[ MailItem ]
├── SentOnBehalfOfName (String) : メールのヘッダー情報（代理送信元）を偽装/指定するのみ
└── SendUsingAccount (Account) : 実際に送信に使用する物理的なアカウント（Transport）
概念の違い
| プロパティ | 型 | 役割と動作 | 必要な条件 |
| :— | :— | :— | :— |
| `SentOnBehalfOfName` | `String` | 表示上の「送信元」を上書きする。送信パイプ自体はプライマリアカウントのまま。 | Exchange等で「代理送信」権限が必須。権限がないと無視または送信エラー。 |
| `SendUsingAccount` | `Account` | Outlookの `Session.Accounts` に存在するアカウントオブジェクトそのものを割り当て、送信パイプを切り替える。 | `Application.Session.Accounts` に対象アカウントが登録されていること。 |
結論として、マルチアカウント環境で送信元を切り替える場合の解は `MailItem.SendUsingAccount` 一択です。
ここに適切な `Outlook.Account` オブジェクトを紐付けることこそが、バグのない自動化の絶対条件となります。
—
3. 送信元自動判定エンジンの設計原則
実務で耐えうる自動判定エンジンを構築するには、以下の4原則を考慮して設計する必要があります。
1. ドメインのマッピング構造の分離
宛先ドメインと送信元アカウントの対応関係（マッピング表）は、主処理から分離・カプセル化する。将来的にCSVやデータベース連携へ拡張できるように考慮する。
2. 複数の宛先（To/CC）に対する評価優先順位
`To` に複数のドメインが存在する場合、どのドメインを最優先して判定するかルールを決める（基本は第1宛先ドメイン）。
3. 完全一致ではなく正規化されたドメイン抽出
メールアドレスからドメイン部を取り出し、小文字化（`LCase`）およびトリミングを施して比較する。
4. フォールバック（退避）機構の完全性
マッピングルールに合致しないドメインの場合、安全なデフォルトアカウントを選択し、決して「未設定のまま送信」させない。
—
4. プロダクショングレードのVBA実装コード
以下のコードは、そのままモジュールに貼り付けて動作する完全な実装例です。
ドメイン判定ロジック、アカウント検索エンジン、メール作成ロジックを責務ごとに分離しています。
Option Explicit
‘ ==============================================================================
‘ 業務自動化エンジン: 宛先ドメインに応じた送信元アカウント自動切替モジュール
‘ ==============================================================================
”’
”’
Public Sub CreateAndSendMailAutoAccount()
Dim mail As Outlook.MailItem
Dim targetAccount As Outlook.Account
‘ テストデータ定義（実務では引数やExcel/DBから取得）
Dim recipientTo As String
Dim emailSubject As String
Dim emailBody As String
recipientTo = “client-user@external-partner.com” ‘ 対象の宛先
emailSubject = “【プロジェクト】進捗のご報告”
emailBody = “お世話になっております。本日の進捗です。”
On Error GoTo ErrorHandler
‘ 1. MailItemの生成
Set mail = Application.CreateItem(olMailItem)
‘ 2. 宛先の設定（アカウント判定のために先に設定が必要）
mail.To = recipientTo
mail.Subject = emailSubject
mail.Body = emailBody
‘ 3. 宛先ドメインに基づき送信元Accountオブジェクトを判定・取得
Set targetAccount = ResolveAccountByRecipients(mail.To)
‘ 4. アカウントの物理割り当て
If Not targetAccount Is Nothing Then
Set mail.SendUsingAccount = targetAccount
‘ ログ出力（デバッグ用）
Debug.Print “送信設定アカウント: ” & targetAccount.DisplayName & ” (” & targetAccount.SmtpAddress & “)”
Else
Err.Raise vbObjectError + 5100, “CreateAndSendMailAutoAccount”, “適切な送信元アカウントが見つかりません。”
End If
‘ 5. 表示または送信
‘ ※実用時は mail.Send に切り替え。開発時は .Display を推奨
mail.Display
CleanUp:
‘ COMオブジェクトの適切な解放
Set mail = Nothing
Set targetAccount = Nothing
Exit Sub
ErrorHandler:
MsgBox “エラーが発生しました: ” & Err.Number & vbCrLf & _
“詳細: ” & Err.Description, vbCritical, “メール生成エラー”
Resume CleanUp
End Sub
”’
”’
”’ カンマまたはセミコロン区切りの宛先文字列
”’
Private Function ResolveAccountByRecipients(ByVal toAddresses As String) As Outlook.Account
Dim targetDomain As String
Dim matchedSmtpAddress As String
Dim selectedAccount As Outlook.Account
‘ 1. 第1宛先からドメインを抽出
targetDomain = ExtractDomainFromRecipient(toAddresses)
‘ 2. ドメインマッピングテーブル（ルール）の評価
‘ ※実務でマッピングが増える場合は外部ファイル(JSON/CSV)やDB化を検討
matchedSmtpAddress = GetTargetSmtpAddressByDomain(targetDomain)
‘ 3. SMTPアドレスからOutlook内部のアカウントオブジェクトを特定
If matchedSmtpAddress <> “” Then
Set selectedAccount = FindAccountBySmtpAddress(matchedSmtpAddress)
End If
‘ 4. フォールバック処理：一致するアカウントがない場合、デフォルトアカウントを使用
If selectedAccount Is Nothing Then
Debug.Print “警告: マッピング不一致のためデフォルトアカウントを割り当てます。Domain: ” & targetDomain
Set selectedAccount = Application.Session.Accounts.Item(1) ‘ 既定のアカウント
End If
Set ResolveAccountByRecipients = selectedAccount
End Function
”’
”’
Private Function GetTargetSmtpAddressByDomain(ByVal domain As String) As String
‘ 大小文字を区別せずに評価
Select Case LCase(Trim(domain))
Case “external-partner.com”, “client-a.co.jp”
GetTargetSmtpAddressByDomain = “sales-dept@your-company.com”
Case “dev-group.net”, “internal-system.local”
GetTargetSmtpAddressByDomain = “tech-support@your-company.com”
Case “vip-client.com”
GetTargetSmtpAddressByDomain = “executive-office@your-company.com”
Case Else
‘ 該当なしの場合は空文字（フォールバックへ）
GetTargetSmtpAddressByDomain = “”
End Select
End Function
”’
”’
Private Function FindAccountBySmtpAddress(ByVal targetSmtp As String) As Outlook.Account
Dim acc As Outlook.Account
Dim resultAcc As Outlook.Account
Set resultAcc = Nothing
‘ Session.Accountsコレクションを全探索
For Each acc In Application.Session.Accounts
‘ SmtpAddress プロパティが存在しない古い環境への耐性として LCase(acc.SmtpAddress) を評価
If LCase(Trim(acc.SmtpAddress)) = LCase(Trim(targetSmtp)) Then
Set resultAcc = acc
Exit For
End If
Next acc
Set FindAccountBySmtpAddress = resultAcc
End Function
”’
”’
Private Function ExtractDomainFromRecipient(ByVal recipientString As String) As String
Dim firstAddress As String
Dim atPos As Long
‘ 複数宛先（; や , 区切り）の最初の1つを取得
firstAddress = recipientString
If InStr(firstAddress, “;”) > 0 Then
firstAddress = Split(firstAddress, “;”)(0)
End If
If InStr(firstAddress, “,”) > 0 Then
firstAddress = Split(firstAddress, “,”)(0)
End If
‘ DisplayName
If InStr(firstAddress, “<") > 0 And InStr(firstAddress, “>”) > 0 Then
firstAddress = Mid(firstAddress, InStr(firstAddress, “<") + 1, InStr(firstAddress, ">“) – InStr(firstAddress, “<") - 1)
End If
' ドメイン部の抽出
atPos = InStr(firstAddress, "@")
If atPos > 0 Then
ExtractDomainFromRecipient = Trim(Mid(firstAddress, atPos + 1))
Else
ExtractDomainFromRecipient = “”
End If
End Function
—
5. コードの解説と堅牢性を担保するテクニック
上記のコードには、現場でのトラブルを防ぐためのチーフアーキテクト級の工夫がいくつか組み込まれています。
① `FindAccountBySmtpAddress` による完全参照一致
単に文字列のアドレスを渡すのではなく、`Application.Session.Accounts` をイテレートして、Outlookが認識している本物の `Outlook.Account` オブジェクトを特定しています。
これにより、プロファイル内に存在しない非アクティブなアドレスが指定された場合の予期せぬクラッシュを回避できます。
② メールアドレス解析（`ExtractDomainFromRecipient`）の堅牢性
実務の宛先文字列は、`hoge@example.com` のような単純な形だけではありません。
- `山田 太郎
- `a@example.com; b@example.com` （複数宛先）
これらが混ざった入力に対しても、文字列検索（`InStr`, `Split`）を組み合わせて確実に `@` 以降の純粋なドメイン文字列を取得するよう設計されています。
③ クリーンアップ処理とエラーハンドリング
VBAにおけるCOMオブジェクト操作では、変数の解放漏れがメモリリークやOutlookのゴーストプロセス化を引き起こします。`On Error GoTo ErrorHandler` パターンを用い、例外発生時でも必ず `CleanUp` ラベルを経由して `Set mail = Nothing` を実行するライフサイクルを構築しています。
—
6. エンタープライズ開発への拡張：外部ファイル／DB連携への発展
規模が拡大し、マッピング対象のドメインが数百件に及ぶ場合、ソースコード内の `Select Case` で管理するのはアンチパターンです。保守性を極限まで高めるため、以下の設計へリファクタリングすることを推奨します。
[ Domain Mapping Config (CSV / SQLite / Config Sheet) ]
│
▼ Read
[ Dynamic Dictionary (Scripting.Dictionary) ]
│
▼ Lookup
[ SendUsingAccount Assignment Logic ]
実装のヒント：外部CSV等から読み込む場合
`GetTargetSmtpAddressByDomain` 内で `Scripting.Dictionary` を静的変数（`Static`）として保持し、初回呼び出し時のみ外部設定ファイル（CSVやExcelシート）からデータを読み込んでメモリにキャッシュします。
‘ 擬似コード：静的ディクショナリによる高速キャッシュ
Private Function GetTargetSmtpAddressByDomain(ByVal domain As String) As String
Static domainMap As Object
If domainMap Is Nothing Then
Set domainMap = CreateObject(“Scripting.Dictionary”)
domainMap.CompareMode = 1 ‘ TextCompare (大文字小文字を区別しない)
‘ ここで外部CSV等の読み込み処理を実行し、domainMapにAddする
‘ 例: domainMap.Add “client-a.com”, “sales@company.com”
End If
If domainMap.Exists(domain) Then
GetTargetSmtpAddressByDomain = domainMap(domain)
Else
GetTargetSmtpAddressByDomain = “”
End If
End Function
—
7. まとめ
Outlook VBAにおけるマルチアカウント制御の成否は、「`SentOnBehalfOfName` の誤用をやめ、`Application.Session.Accounts` から正しい `SendUsingAccount` オブジェクトを引き当てられるか」にかかっています。
本記事で提示したアーキテクチャパターンを適用することで、以下のメリットが得られます。
- 安全性の確保: 送信ミスや未権限エラーによる誤送信事故の防止
- 保守性の向上: ドメイン判定ロジックとアカウント検索ロジックの分離
- 拡張性: 将来的な外部データベースや設定ファイル連携への容易な移行
システム開発担当者の方は、ぜひこの堅牢な判定エンジンを基盤として導入し、バグのない強固な自動化ツールを構築してください。
