【Outlook VBA】送信済みアイテムから「真の宛先」を爆速抽出する：DASLクエリとRecipientsオブジェクトによる堅牢なCSVエクスポート設計
現場で自動化ツールを開発しているエンジニア諸君、まさか 「送信済みアイテム」の全メールを `For Each` でループ回して判定する というような、素人同然のコードを書いたりはしていないだろうか？
件数が数十件程度なら動作するかもしれない。だが、数万件のメールが蓄積された本番環境でそれを実行した瞬間、Outlookはフリーズし、メモリエラーを引き起こす。また、`MailItem.To` プロパティから取得した宛先文字列をカンマ区切りで分解してよしとする設計も、実務においては完全に破綻する。Exchange環境では内部識別子（X.500形式）が返され、真のSMTPメールアドレスが取得できないからだ。
本記事では、過去の送信履歴から特定の条件に合致するターゲットをミリ秒単位でフィルタリングし、TO / CC / BCCの区別も含めた正確な宛先リスト（SMTPアドレス）をUTF-8（BOM付き）CSVとしてエクスポートするエンタープライズクオリティの解法を提示する。
—
1. なぜ「全件ループ」と「MailItem.To」はアンチパターンなのか？
設計思想の根幹として、まず「やってはいけない実装」とその理論的背景を刻み込んでほしい。
① `Items.Restrict`（DASLクエリ） vs `For Each` ループ
`SentFolder.Items` 全体にループを回す処理は、$O(N)$ の計算量を要求する。しかもVBAからMAPIストレージ層に対して毎回オブジェクトのフェッチ（読み出し）が発生するため、ネットワークオーバーヘッドとメモリ消費が劇的に増加する。
使うべきは `Items.Restrict` メソッドであり、さらにプロパティの検索には DASL（MAPI Data Access Language）クエリ を採用する。MAPI層のインデックスを利用してサーバー／ローカルデータベース側でフィルタリングを行わせることで、$O(1)$ に近い応答速度で必要な `MailItem` の参照だけを絞り込むことができる。
② `MailItem.To` や `MailItem.CC` を直接参照するリスク
`MailItem.To` は、単なる「表示名（Display Name）」の結合文字列を返すケースが多々ある。
特に社内Exchange環境やMicrosoft 365環境においては、以下のような文字列が返ってくる。
/o=ExchangeLabs/ou=Exchange Administrative Group/cn=Recipients/cn=1234567890abcdef-User
これでは外部送信リストや分析データとしては完全に無価値だ。
正確なアドレスを抽出するためには、`MailItem.Recipients` コレクションをループし、MAPIプロパティタグである `PR_SMTP_ADDRESS` (`0x39FE001E`) を `PropertyAccessor` 経由で直接叩く必要がある。
—
2. 堅牢なCSV出力とCOMオブジェクトの完全開放
実務でそのまま動くツールを作る以上、ファイルIOとメモリ管理にも一切の妥協は許されない。
- 文字コードの問題: 標準の `Open For Output` はShift-JIS出力となり、海外宛先の表示名や特殊文字で文字化けを起こす。本設計では `ADODB.Stream` を用い、Excelでダブルクリックしても文字化けしない UTF-8（BOM付き） で出力する。
- COMライフサイクルの明示的管理: Outlook VBAにおける最大のエラー要因は、暗黙的なオブジェクトの参照残存によるメモリリークや、次回実行時の動作不定である。`Set obj = Nothing` の徹底と、適切なエラーハンドリングによるクリーンアップ処理を確定させる。
—
3. プロダクションコード例
以下のコードをVBAエディタ（標準モジュール）に貼り付け、実行環境に合わせて定数を調整するだけで、そのまま業務に投入可能なツールとして機能する。
Option Explicit
‘ ==============================================================================
‘ 処理名: ExportSentMailRecipientsToCSV
‘ 概要 : 送信済みアイテムから特定条件のメールをDASL高速検索し、
‘ すべての宛先(TO/CC/BCC)の真のSMTPアドレスをCSVに出力する
‘ 著者 : Chief Architect
‘ ==============================================================================
Public Sub ExportSentMailRecipientsToCSV()
On Error GoTo ErrorHandler
‘ ————————————————————————–
‘ 1. 設定パラメータ定義（業務仕様に合わせて変更）
‘ ————————————————————————–
Const SEARCH_SUBJECT As String = “月次報告” ‘ 検索対象の件名部分一致キーワード
Const DAYS_BACK As Long = 30 ‘ 過去何日分を検索対象とするか
Const OUTPUT_CSV_PATH As String = “C:\Temp\SentRecipients_List.csv” ‘ 出力先パス
‘ ————————————————————————–
‘ 2. オブジェクト定義
‘ ————————————————————————–
Dim olApp As Outlook.Application
Dim olNS As Outlook.NameSpace
Dim sentFolder As Outlook.MAPIFolder
Dim rawItems As Outlook.Items
Dim filteredItems As Outlook.Items
Dim targetItem As Object ‘ MailItem以外（ReportItem等）の混在を考慮してObject型
Dim mail As Outlook.MailItem
Dim recip As Outlook.Recipient
Dim pa As Outlook.PropertyAccessor
‘ ADODB.Stream（遅延結合: 参照設定不要）
Dim stream As Object
‘ MAPIプロパティ定義 (PR_SMTP_ADDRESS)
Const PR_SMTP_ADDRESS As String = “http://schemas.microsoft.com/mapi/proptag/0x39FE001E”
‘ ————————————————————————–
‘ 3. Outlookフォルダの取得とDASLフィルタリング
‘ ————————————————————————–
Set olApp = Outlook.Application
Set olNS = olApp.GetNamespace(“MAPI”)
Set sentFolder = olNS.GetDefaultFolder(olFolderSentMail)
Set rawItems = sentFolder.Items
‘ 日時フィルター用フォーマット作成 (UTC考慮のISO形式または標準形式)
Dim startDate As String
startDate = Format(DateAdd(“d”, -DAYS_BACK, Date), “yyyy/mm/dd hh:nn”)
‘ DASLクエリの構築
‘ 件名に指定文字列を含み、かつ指定日時以降に送信されたメールを絞り込む
Dim daslFilter As String
daslFilter = “@SQL=” & _
“””http://schemas.microsoft.com/mapi/proptag/0x0037001E”” LIKE ‘%” & SEARCH_SUBJECT & “%'” & _
” AND “”http://schemas.microsoft.com/mapi/proptag/0x0E060040″” >= ‘” & startDate & “‘”
‘ 高速絞り込み実行
Set filteredItems = rawItems.Restrict(daslFilter)
‘ ————————————————————————–
‘ 4. ADODB.Stream による CSV出力準備 (UTF-8 BOM付き)
‘ ————————————————————————–
Set stream = CreateObject(“ADODB.Stream”)
stream.Type = 2 ‘ adTypeText
stream.Charset = “UTF-8”
stream.Open
‘ ヘッダー行の書き込み (ダブルクォート囲み標準)
stream.WriteText “””送信日時””,””件名””,””種別””,””表示名””,””SMTPアドレス””” & vbCrLf
‘ ————————————————————————–
‘ 5. データ抽出ループ
‘ ————————————————————————–
Dim exportCount As Long: exportCount = 0
Dim i As Long
‘ Restrictの結果セットに対してループ
For i = filteredItems.Count To 1 Step -1
Set targetItem = filteredItems.Item(i)
‘ MailItemオブジェクトのみを処理（配信不能レポート等のReportItemを排除）
If TypeOf targetItem Is MailItem Then
Set mail = targetItem
‘ 該当メールの全宛先を走査
For Each recip In mail.Recipients
Dim recipType As String
Select Case recip.Type
Case olTo: recipType = “TO”
Case olCC: recipType = “CC”
Case olBCC: recipType = “BCC”
Case Else: recipType = “UNKNOWN”
End Select
‘ PropertyAccessorを用いてPR_SMTP_ADDRESSを取得
Dim smtpAddress As String
smtpAddress = “”
On Error Resume Next ‘ アドレス解析不能な特殊オブジェクト対策
Set pa = recip.PropertyAccessor
smtpAddress = pa.GetProperty(PR_SMTP_ADDRESS)
On Error GoTo ErrorHandler
‘ 取得失敗時はFallbackとしてAddressプロパティを使用
If smtpAddress = “” Then
smtpAddress = recip.Address
End If
‘ CSVレコードの書き込み (カンマ・改行のエスケープ処理含む)
Dim csvRow As String
csvRow = EscapeCsv(Format(mail.SentOn, “yyyy/mm/dd hh:nn:ss”)) & “,” & _
EscapeCsv(mail.Subject) & “,” & _
EscapeCsv(recipType) & “,” & _
EscapeCsv(recip.Name) & “,” & _
EscapeCsv(smtpAddress)
stream.WriteText csvRow & vbCrLf
exportCount = exportCount + 1
Set pa = Nothing
Next recip
End If
‘ ループ内でのメモリ解放
Set mail = Nothing
Set targetItem = Nothing
Next i
‘ ————————————————————————–
‘ 6. ファイルへの保存と終了処理
‘ ————————————————————————–
If exportCount > 0 Then
‘ SaveToFile (2 = adSaveCreateOverWrite)
stream.SaveToFile OUTPUT_CSV_PATH, 2
MsgBox “エクスポートが完了しました。” & vbCrLf & _
“抽出レコード数: ” & exportCount & ” 件” & vbCrLf & _
“保存先: ” & OUTPUT_CSV_PATH, vbInformation, “完了”
Else
MsgBox “該当する条件の送信済みメールは見つかりませんでした。”, vbExclamation, “処理結果”
End If
CleanUp:
‘ 明示的なオブジェクト解放（リーク防止）
If Not stream Is Nothing Then
stream.Close
Set stream = Nothing
End If
Set pa = Nothing
Set recip = Nothing
Set mail = Nothing
Set targetItem = Nothing
Set filteredItems = Nothing
Set rawItems = Nothing
Set sentFolder = Nothing
Set olNS = Nothing
Set olApp = Nothing
Exit Sub
ErrorHandler:
MsgBox “予期せぬエラーが発生しました。” & vbCrLf & _
“エラー番号: ” & Err.Number & vbCrLf & _
“エラー詳細: ” & Err.Description, vbCritical, “システムエラー”
Resume CleanUp
End Sub
‘ ==============================================================================
‘ 局所関数: EscapeCsv
‘ 概要 : CSVフォーマットに従い文字列をダブルクォートで安全にエスケープする
‘ ==============================================================================
Private Function EscapeCsv(ByVal inputStr As String) As String
‘ ダブルクォートを2重化
Dim escaped As String
escaped = Replace(inputStr, “”””, “”””””)
‘ 全体をダブルクォートで囲む
EscapeCsv = “””” & escaped & “”””
End Function
—
4. チーフアーキテクトによるコード解説と補足仕様
このコードが「なぜ現場でバグを起こさないのか」、重要な設計のポイントを解説する。
1. DASLクエリによるフィルタリングの肝
daslFilter = “@SQL=” & _
“””http://schemas.microsoft.com/mapi/proptag/0x0037001E”” LIKE ‘%” & SEARCH_SUBJECT & “%'” & _
” AND “”http://schemas.microsoft.com/mapi/proptag/0x0E060040″” >= ‘” & startDate & “‘”
- `0x0037001E` は MAPIプロパティタグ `PR_SUBJECT`（件名）を意味する。
- `0x0E060040` は `PR_CLIENT_SUBMIT_TIME`（送信日時）を意味する。
これらを `@SQL=` プレフィックスを付けて評価させることで、Outlookエンジン側でインデックス走査が行われ、余計なオブジェクトフェッチを極限まで削減している。
2. `PR_SMTP_ADDRESS` (0x39FE001E) の破壊力
Exchange環境において、`Recipient.Address` は `/o=Exchange…` という組織内固有のX.500アドレスを返すケースがある。
本コードでは、`PropertyAccessor.GetProperty(“http://schemas.microsoft.com/mapi/proptag/0x39FE001E”)` を指定することで、MAPIの内部プロパティに直接アクセスし、組織内ユーザーであっても純粋な `user@domain.com` 形式のSMTPアドレスを確実に引き抜いている。
3. CSVエスケープ処理の標準化
エクスポート対象の件名や宛先表示名に「カンマ(`,`)」や「ダブルクォーテーション(`”`)」が含まれている場合、一般的な文字列結合ではCSVの構造が崩壊する。
`EscapeCsv` 関数により、RFC 4180（CSVの標準仕様）に準拠した形式への変換を徹底している。
4. 逆順ループ（`For i = filteredItems.Count To 1 Step -1`）
コレクションを走査する際、将来的にアイテムの移動や削除などの拡張を行うことを見越し、インデックスの繰り上がり問題（Index Out of Bounds）を防止する堅牢な実装パターンを標準採用している。
—
5. まとめ
業務効率化ツールにおいて、「動けばいい」という考え方で書かれたコードは、扱うデータ量が増えた瞬間にシステムの「爆弾」へと変貌する。
今回提示した設計は、以下の3原則をクリアしている。
1. DASLクエリによるメモリとI/Oの最小化
2. MAPIプロパティ直接参照による「真のSMTPアドレス」の取得
3. ADODB.StreamとRFC4180準拠のエクスエスケープによるデータ安全性の担保
中級者のエンジニア諸君は、単にコードをコピーするだけでなく、「なぜこのプロパティを叩くのか」「なぜこのクエリ構造にするのか」というアーキテクチャの理由を理解し、保守性とパフォーマンスの高いツール開発を推進してほしい。
