【実務・中級編】【上級者向け】添付ファイル保存後に元のメールの本文をテキストとして抽出・保存するアーカイブシステム – Outlook VBA解析バイブル

「単なる保存」で終わるな。検索性を担保する「高信頼性メールアーカイブ・エンジン」の設計思想

現場で「メールの添付ファイルを自動保存するツールを作った」と報告してくるジュニアエンジニアのコードを、私はよく目にする。そのコードのほとんどは、例外処理が欠如しており、ファイル名に禁止文字が含まれていれば即座にクラッシュし、大量のメールが届いた際にはリソースを食いつぶしてOutlookごと道連れにする。

業務自動化における「プロダクション・レベル」とは、正常系を動かすことではない。「予測不可能な異常系」をいかにエレガントに、かつシステム全体を止めずに処理するかにこそ、エンジニアの真価が問われる。

本記事では、添付ファイルの保存に留まらず、メール本文をテキストとして抽出・アーカイブし、後からの「全文検索」を可能にする、高度なアーカイブシステムの設計と実装について解説する。

1. アーキテクチャの要諦：なぜ「ただの保存」では失敗するのか

多くの開発者が陥る罠は、メールの「件名（Subject）」をそのままファイル名に利用しようとすることだ。

ファイル名汚染（Filename Sanitization）

Windowsのファイルシステムには、`\ / : * ? ” < > |` といった使用禁止文字が存在する。メールの件名にはこれらが頻繁に含まれる。これらを考慮せずに `SaveAs` を実行すれば、実行時エラーでプロセスは停止する。

オブジェクト・ライフサイクルとイベントの同期

`NewMail` イベントを利用する場合、メールが受信された瞬間にオブジェクトがメモリ上に確保されるが、その処理が重すぎると、次々と届くメールの処理が追いつかず、スタックオーバーフローやメモリリークを引き起こす。処理は「軽量」に、そして「非同期的な思考」を持って設計しなければならない。

検索性の設計（Text Extraction）

添付ファイルだけを保存しても、情報の本体である「文脈（Context）」は失われる。メール本文を `.txt` 形式で別途保存し、ファイル名に受信日時と件名を適切に含めることで、Windows Searchや外部の全文検索エンジンがインデックスを貼りやすい構造を作る必要がある。

2. 実装戦略：堅牢なアーカイブエンジンの設計図

我々が実装すべきは、以下の3つのコンポーネントを持つモジュールである。

1. Sanitizer（洗浄）: 文字列から不正な文字を排除し、安全なファイル名を生成する。
2. Extractor（抽出）: 添付ファイルと本文を、定義されたディレクトリ構造に従って分離・保存する。
3. Logger/Error Handler（監視）: 失敗を無視せず、何が起きたかを記録する。

3. プロダクション・コード：高信頼性アーカイブ・モジュール

以下に、そのまま実務に投入できるレベルのコードを示す。単なるコピペではなく、各行の意図を理解してほしい。

準備

`Tools` -> `References` から Microsoft Scripting Runtime にチェックを入れておけ。`FileSystemObject` を使うことで、ファイル操作の信頼性を劇的に向上させる。

標準モジュールへの実装

Option Explicit

' ==============================================================================
' 構成定数
' ==============================================================================
Private Const ARCHIVE_ROOT As String = "C:\MailArchive\" ' アーカイブのルートパス
Private Const LOG_FILE As String = "C:\MailArchive\error_log.txt"

' ==============================================================================
' メインエントリーポイント: メール受信時に呼び出される
' ==============================================================================
Public Sub ProcessIncomingMail(ByVal Item As Object)
    On Error GoTo ErrorHandler

    ' MailItemであることを確認（会議出席依頼などを除外）
    If Not TypeOf Item Is MailItem Then Exit Sub

    Dim mail As MailItem
    Set mail = Item

    Dim timestamp As String
    timestamp = Format(mail.ReceivedTime, "yyyyMMdd_HHmmss")

    Dim safeSubject As String
    safeSubject = SanitizeFileName(mail.Subject)

    ' 保存用ディレクトリの作成 (日付単位の階層構造を推奨)
    Dim targetDir As String
    targetDir = ARCHIVE_ROOT & Format(mail.ReceivedTime, "yyyy-mm-dd") & "\"
    CreateFolderRecursive targetDir

    ' 1. 本文のテキスト抽出と保存
    SaveMailBody mail, targetDir, timestamp, safeSubject

    ' 2. 添付ファイルの保存
    SaveAttachments mail, targetDir, timestamp, safeSubject

    Exit Sub

ErrorHandler:
    LogError "ProcessIncomingMail Error: " & Err.Description & " | Subject: " & mail.Subject
End Sub

' ==============================================================================
' 本文をテキストとして保存する
' ==============================================================================
Private Sub SaveMailBody(ByVal mail As MailItem, ByVal dir As String, ByVal ts As String, ByVal subject As String)
    Dim filePath As String
    filePath = dir & ts & "_" & subject & "_body.txt"

    Dim fso As New FileSystemObject
    Dim textStream As TextStream
    
    ' TextMode:=ForWriting で新規作成または上書き
    Set textStream = fso.CreateTextFile(filePath, True, True) ' Unicode(UTF-16)で保存
    
    ' 本文を書き込み（HTMLBodyではなくBodyを使うことでタグを除去）
    textStream.WriteLine "--- Metadata ---"
    textStream.WriteLine "Sent: " & mail.SentOn
    textStream.WriteLine "From: " & mail.SenderName & " <" & mail.SenderEmailAddress & ">"
    textStream.WriteLine "Subject: " & mail.Subject
    textStream.WriteLine "----------------"
    textStream.WriteLine ""
    textStream.WriteLine mail.Body
    
    textStream.Close
End Sub

' ==============================================================================
' 添付ファイルを保存する
' ==============================================================================
Private Sub SaveAttachments(ByVal mail As MailItem, ByVal dir As String, ByVal ts As String, ByVal subject As String)
    If mail.Attachments.Count = 0 Then Exit Sub

    Dim att As Attachment
    Dim fso As New FileSystemObject
    Dim attPath As String
    Dim safeAttName As String

    For Each att In mail.Attachments
        ' ファイル名から不正文字を除去
        safeAttName = SanitizeFileName(att.FileName)
        attPath = dir & ts & "_" & subject & "_" & safeAttName
        
        ' 保存実行
        att.SaveAsFile attPath
    Next att
End Sub

' ==============================================================================
' 【極めて重要】ファイル名から禁止文字を排除する
' ==============================================================================
Private Function SanitizeFileName(ByVal fileName As String) As String
    Dim invalidChars As Variant
    Dim i As Integer
    
    ' Windowsの禁止文字リスト
    invalidChars = Array("\", "/", ":", "*", "?", """", "<", ">", "|")
    
    For i = LBound(invalidChars) To UBound(invalidChars)
        fileName = Replace(fileName, invalidChars(i), "_")
    Next i
    
    ' 改行コードやタブも除去
    fileName = Replace(fileName, vbCr, "")
    fileName = Replace(fileName, vbLf, "")
    fileName = Replace(fileName, vbTab, "")
    
    ' 長すぎる件名はカット（ファイルパス長制限対策）
    If Len(fileName) > 100 Then
        fileName = Left(fileName, 100)
    End If
    
    SanitizeFileName = fileName
End Function

' ==============================================================================
' ユーティリティ: 再帰的なディレクトリ作成
' ==============================================================================
Private Sub CreateFolderRecursive(ByVal path As String)
    Dim fso As New FileSystemObject
    If Not fso.FolderExists(path) Then
        Dim parent As String
        parent = fso.GetParentFolderName(path)
        If Not fso.FolderExists(parent) Then CreateFolderRecursive parent
        fso.CreateFolder path
    End If
End Sub

' ==============================================================================
' ユーティリティ: エラーログ出力
' ==============================================================================
Private Sub LogError(ByVal msg As String)
    On Error Resume Next
    Dim fso As New FileSystemObject
    Dim ts As TextStream
    Set ts = fso.OpenTextFile(LOG_FILE, ForAppending, True)
    ts.WriteLine Now & " | " & msg
    ts.Close
End Sub

4. アーキテクトの視点：運用を見据えた高度なアドバイス

コードを書いただけで満足してはいけない。このシステムを「プロダクション」として運用するために、以下の3点を考慮せよ。

1. 本文抽出における「HTML vs Plain Text」の選択

上記コードでは `mail.Body` を使用している。これはプレーンテキストを取得するため、検索エンジンとの親和性が高く、ノイズ（HTMLタグ）が混入しない。もし、メール内のリンクや書式を保持したい場合は `mail.HTMLBody` を使用することになるが、その場合は検索時にHTMLタグがノイズとなり、検索精度を下げるリスクがあることを忘れるな。

2. ディレクトリ構造のスケール

`ARCHIVE_ROOT\yyyy-mm-dd\` という構造を採用している。これは、1つのフォルダに数万個のファイルが溜まることによる、OSのファイルシステムパフォーマンスの低下を防ぐためだ。数年分のデータを扱うなら、`yyyy\mm\dd` のようにさらに階層を深くすることを検討すべきである。

3. セキュリティと整合性

添付ファイルには、ウイルスやマルウェアが含まれる可能性がある。このツールが動く環境は、常に最新のアンチウイルスソフトがリアルタイムスキャンを行っていることが前提だ。また、保存に失敗したメールを再試行するための「キュー（Queue）」の概念を将来的に導入すると、さらに堅牢なシステムへと進化するだろう。

結びに

自動化の本質は、コードの短さではなく、「システムの予測可能性」にある。
今回提示した設計は、エラーを隠蔽せず、ファイルシステムの制約を正面から受け止め、将来の検索性を計算に入れたものである。

これこそが、単なるスクリプターではなく、エンジニアとして、アーキテクトとして書くべきコードの姿だ。