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

添付ファイル保存の「その先」へ。検索性を極限まで高める「全文アーカイブシステム」の構築術

こんにちは。業務自動化の世界へようこそ。

「マクロの記録」を使って、添付ファイルを特定のフォルダに保存することに成功した……。もしあなたが今、そこに到達しているなら、素晴らしい一歩を踏み出しました。あなたはすでに「単純作業を機械に任せる」というエンジニアの基礎体力を身につけています。

しかし、ここで一つ、プロの視点から問いかけさせてください。

「その保存されたファイル、後から『あの時、なんて書いてあったっけ？』と探すとき、どうやって見つけますか？」

添付ファイルだけをバラバラに保存しても、そのファイルが「いつ、誰から、どんな文脈（本文）で送られてきたのか」という情報は、メールの中に置き去りにされたままです。これでは、情報の断片を拾い集めているだけで、真の「資産」にはなりません。

今日は、単なる「保存マクロ」を卒業し、「メール本文と添付ファイルをセットで、全文検索可能な状態でアーカイブする」という、実務レベルの高度なシステムを一緒に作っていきましょう。

ここをクリアすれば、あなたのOutlook VBAスキルは、単なる「便利ツール」から「業務基盤」へと昇華しますよ。

1. アーカイブシステムの設計図（アーキテクチャ）

いきなりコードを書き始めるのは、設計図なしにビルを建てるようなものです。まずは、私たちが作ろうとしているシステムの動きを整理しましょう。

私たちが目指すのは、メールを受信（または特定のフォルダに移動）した瞬間に、以下のプロセスを自動実行する仕組みです。

【処理のフローチャート】

1. トリガー: 特定のフォルダに新しいメールが入る。
2. 情報の抽出:

• メールの「件名」「送信者」「受信日時」を取得。
• メールの「本文（Text形式）」を抽出。
• 「添付ファイル」をすべてスキャン。

3. クレンジング: ファイル名に使えない禁止文字（`\ / : * ? ” < > |`）を、安全な文字に置換。
4. 物理保存:

• `[日付]_[件名].txt` という名前で、本文をテキスト保存。
• 添付ファイルを、そのテキストファイルと同じ場所に保存。

これによって、Windowsの検索窓や、後述する全文検索ツールから、「メールの中身（テキスト）」をキーワードで叩くだけで、関連する添付ファイルにたどり着けるようになります。

2. 実装：極限のアーカイブコード

それでは、魂を込めて書いたコードを見ていきましょう。
このコードは、`ThisOutlookSession` に記述することを想定しています。

事前準備

このコードでは、ファイル操作を高速かつ精密に行うために 「Microsoft Scripting Runtime」 を使用します。
1. VBAエディタのメニュー [ツール] -> [参照設定] を開く。
2. 「Microsoft Scripting Runtime」 にチェックを入れて OK を押してください。

' --- ThisOutlookSession に記述 ---

Option Explicit

' 監視対象のフォルダを指定するための変数
Private WithEvents TargetFolderItems As Outlook.Items

' 起動時に実行される処理
Private Sub Application_Startup()
    Dim outlookApp As Outlook.Application
    Dim ns As Outlook.NameSpace
    Dim folder As Outlook.MAPIFolder
    
    Set outlookApp = Outlook.Application
    Set ns = outlookApp.GetNamespace("MAPI")
    
    ' 【設定】アーカイブしたいフォルダを指定（例：受信トレイの下の「Archive」フォルダ）
    ' ここでは例として、受信トレイ(olFolderInbox)を指定しています
    Set folder = ns.GetDefaultFolder(olFolderInbox)
    
    ' フォルダのアイテム追加イベントを監視開始
    Set TargetFolderItems = folder.Items
    
    MsgBox "アーカイブ監視システムが起動しました。", vbInformation
End Sub

' フォルダに新しいアイテムが追加された時のイベント
Private Sub TargetFolderItems_ItemAdd(ByVal Item As Object)
    On Error GoTo ErrorHandler
    
    ' メールアイテム以外（会議出席依頼など）は無視する
    If TypeOf Item Is MailItem Then
        Dim mail As Outlook.MailItem
        Set mail = Item
        
        ' --- 設定領域 ---
        Dim saveRootPath As String
        saveRootPath = "C:\Archive\" ' 保存先のルートパス（必ず末尾に \ を入れる）
        ' ----------------
        
        ' 保存用フォルダの作成（なければ作成）
        Dim fso As New FileSystemObject
        If Not fso.FolderExists(saveRootPath) Then
            fso.CreateFolder (saveRootPath)
        End If
        
        ' 1. メールのメタ情報を取得してファイル名を作る
        Dim safeSubject As String
        Dim baseFileName As String
        Dim timestamp As String
        
        timestamp = Format(mail.ReceivedTime, "yyyyMMdd_HHmmss")
        safeSubject = CleanFileName(mail.Subject)
        baseFileName = timestamp & "_" & safeSubject
        
        ' 2. 本文をテキストファイルとして保存
        Dim txtFilePath As String
        txtFilePath = saveRootPath & baseFileName & ".txt"
        
        Dim txtFile As TextStream
        Set txtFile = fso.CreateTextFile(txtFilePath, True, True) ' Unicode形式で保存
        
        txtFile.WriteLine "--- Email Metadata ---"
        txtFile.WriteLine "From: " & mail.SenderName & " <" & mail.SenderEmailAddress & ">"
        txtFile.WriteLine "Received: " & mail.ReceivedTime
        txtFile.WriteLine "Subject: " & mail.Subject
        txtFile.WriteLine "----------------------"
        txtFile.WriteLine ""
        txtFile.WriteLine mail.Body ' ここが全文検索の対象になる！
        txtFile.Close
        
        ' 3. 添付ファイルを保存
        Dim att As Outlook.Attachment
        Dim attPath As String
        For Each att In mail.Attachments
            ' 添付ファイル名もクレンジング
            Dim safeAttName As String
            safeAttName = CleanFileName(att.FileName)
            attPath = saveRootPath & baseFileName & "_" & safeAttName
            
            att.SaveAsFile attPath
        Next att
        
        Debug.Print "Archived: " & baseFileName
    End If

ExitSub:
    Exit Sub

ErrorHandler:
    ' 実務ではエラー内容をログに残すのがプロの鉄則
    Debug.Print "Error in Archive Process: " & Err.Description
    Resume ExitSub
End Sub

' 【重要】ファイル名に使えない禁止文字を置換する関数
' これを怠ると、システムはエラーで止まります
Private Function CleanFileName(ByVal str As String) As String
    Dim illegalChars As Variant
    Dim i As Integer
    
    ' Windowsのファイル名禁止文字リスト
    illegalChars = Array("\", "/", ":", "*", "?", """", "<", ">", "|")
    
    For i = LBound(illegalChars) To UBound(illegalChars)
        str = Replace(str, illegalChars(i), "_")
    Next i
    
    ' 改行コードが含まれている場合も除去
    str = Replace(str, vbCr, "")
    str = Replace(str, vbLf, "")
    
    CleanFileName = Left(str, 100) ' 長すぎる件名はカットして安全策をとる
End Function

3. ここが「プロ」の分かれ道：設計の勘所

コードを書き終えたあなたに、私が設計時に最も神経を使った「3つの急所」を伝授します。これこそが、単なる初心者と、信頼されるエンジニアを分ける境界線です。

① ファイル名の「サニタイジング（無害化）」

初心者が最も陥りやすい罠がこれです。メールの件名には、ファイル名として使えない記号（`:` や `/` など）が頻繁に含まれます。これをそのまま `SaveAsFile` しようとすると、VBAは「パスが見つかりません」という無慈悲なエラーを吐いて停止します。
`CleanFileName` 関数を用意し、記号をアンダースコア `_` に置換するのは、堅牢なシステムを作るための儀式だと覚えておいてください。

② `Body` プロパティの選択

メールには `HTMLBody`（装飾あり）と `Body`（プレーンテキスト）の2種類があります。
今回はあえて `Body` を選択しました。なぜなら、「全文検索」が目的であれば、HTMLタグ（`