【入門編】【中級者向け】FSOを活用した「月別・取引先別」フォルダの自動生成と添付ファイルの仕分け保存 – Outlook VBA解析バイブル

Outlook VBAを掌握する極限の知見：FSOで構築する「思考する」ファイル管理システム

こんにちは。自動化の深淵へようこそ。

「マクロの記録」ボタンを押して、何とか動くコードを手に入れた。そこまでは素晴らしい第一歩です。しかし、あなたがもし「自動化の先にある『管理の美学』」を目指すなら、今のコードではまだ足りません。

例えば、大量の添付ファイルをただ一つのフォルダに「ドサッ」と保存するマクロ。それは自動化ではあっても、「管理」ではありません。後でファイルを探すときに、結局人間が手作業で仕分けをする羽目になる……これでは本末転倒です。

今日、私があなたに伝授するのは、FileSystemObject（FSO）を駆使して、メールの内容（日付や送信者）を読み取り、「年月」と「取引先名」で階層構造を自動構築しながら保存する、プロフェッショナルな設計思想です。

ここをクリアすれば、あなたのOutlook VBAは「単なる作業代行」から「自律的な管理システム」へと進化します。さあ、一緒にコードの裏側にある設計思想を学んでいきましょう。

1. なぜ「Dir関数」ではなく「FSO」なのか？

VBAでフォルダを操作するとき、初心者はよく `Dir` 関数を使います。しかし、プロフェッショナルは迷わず FileSystemObject (FSO) を選択します。その決定的な違いは「オブジェクト指向による操作の直感性と拡張性」にあります。

FSOを使うことで、「もしフォルダがなければ作る」「もしファイルが既に存在したら名前を変える」といった、複雑な条件分岐を非常にスマートに記述できるようになります。

2. 実装の設計図：階層構造のロジック

今回のゴールは、以下のようなフォルダ構造を自動で作り上げることです。

[保存先ルート]
  ┗ 2023年
      ┗ 10月
          ┗ 株式会社ABC商事
              ┗ invoice_20231001.pdf
          ┗ XYZテクノロジー
              ┗ order_form.xlsx

この構造を実現するためには、以下の3つのステップをコードに組み込みます。

1. 情報の抽出: 受信メールから「受信日」と「送信者名」を取り出す。
2. パスの生成: 「年」「月」「送信者」を組み合わせたフルパスを組み立てる。
3. フォルダの動的生成: パスを辿り、存在しない階層を一つずつ作成していく。

3. 【実践】極限の仕分けマクロ

それでは、実際のコードを見ていきましょう。このコードは、「現在選択しているメール」に対して処理を行います。

事前準備（重要！）

このコードではFSOの機能を最大限に引き出すため、「参照設定」を行います。
1. VBAエディタのメニューから [ツール] -> [参照設定] を開く。
2. 「Microsoft Scripting Runtime」 にチェックを入れて [OK] を押す。
*これを行うことで、コードの補完（インテリセンス）が効くようになり、実行速度も向上します。*

Option Explicit

''' <summary>
''' 選択中のメールの添付ファイルを「年/月/送信者」フォルダへ自動仕分け保存する
''' </summary>
Sub SaveAttachmentsWithSmartHierarchy()
    ' --- 設定エリア ---
    Const ROOT_PATH As String = "C:\Users\YourName\Desktop\MailAttachments\" ' ★保存先のルートパスを必ず書き換えてください
    ' ------------------

    Dim objSelection As Outlook.Selection
    Dim objMail As Outlook.MailItem
    Dim objAttachment As Outlook.Attachment
    Dim fso As New Scripting.FileSystemObject
    Dim targetFolder As String
    Dim yearFolder As String, monthFolder As String, clientFolder As String
    Dim clientName As String
    Dim receivedDate As Date
    Dim savePath As String
    
    ' 選択されているアイテムを取得
    Set objSelection = Outlook.Application.ActiveExplorer.Selection
    
    ' 選択されているものがメールでない場合は終了
    If objSelection.Count = 0 Or TypeName(objSelection.Item(1)) <> "MailItem" Then
        MsgBox "メールを選択してから実行してください。", vbExclamation
        Exit Sub
    End If

    ' ルートフォルダが存在するかチェック
    If Not fso.FolderExists(ROOT_PATH) Then
        MsgBox "指定されたルートパスが存在しません: " & ROOT_PATH, vbCritical
        Exit Sub
    End If

    ' 選択中の各メールに対して処理
    For Each objMail In objSelection
        receivedDate = objMail.ReceivedTime
        
        ' 【プロの知恵】送信者名からファイル名に使えない禁止文字を除去する
        clientName = CleanFileName(objMail.SenderName)
        
        ' 階層パスの組み立て
        yearFolder = ROOT_PATH & Format(receivedDate, "yyyy年") & "\"
        monthFolder = yearFolder & Format(receivedDate, "mm月") & "\"
        clientFolder = monthFolder & clientName & "\"
        
        ' フォルダの階層を順に作成（存在しない場合のみ）
        CreateFolderRecursive fso, yearFolder
        CreateFolderRecursive fso, monthFolder
        CreateFolderRecursive fso, clientFolder
        
        ' 添付ファイルの保存処理
        If objMail.Attachments.Count > 0 Then
            For Each objAttachment In objMail.Attachments
                ' 保存フルパスの決定
                savePath = clientFolder & objAttachment.FileName
                
                ' 同名ファイルがある場合の衝突回避策
                If fso.FileExists(savePath) Then
                    savePath = clientFolder & Format(Now, "hhmmss_") & objAttachment.FileName
                End If
                
                ' 保存実行
                objAttachment.SaveAsFile savePath
            Next objAttachment
        End If
    Next objMail

    MsgBox "仕分け作業が完了しました！", vbInformation
End Sub

''' <summary>
''' フォルダを再帰的に作成するヘルパー関数
''' </summary>
Private Sub CreateFolderRecursive(fso As Scripting.FileSystemObject, ByVal path As String)
    ' パスの末尾に "\" がある場合は除去して判定
    If Right(path, 1) = "\" Then path = Left(path, Len(path) - 1)
    
    ' 親フォルダが存在しなければ、親フォルダを作成しに行く（再帰）
    Dim parentPath As String
    parentPath = fso.GetParentFolderName(path)
    
    If Not fso.FolderExists(parentPath) Then
        CreateFolderRecursive fso, parentPath
    End If
    
    ' 自身のフォルダが存在しなければ作成
    If Not fso.FolderExists(path) Then
        fso.CreateFolder path
    End If
End Sub

''' <summary>
''' ファイル名に使用できない禁止文字をアンダースコアに置換する
''' </summary>
Private Function CleanFileName(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
    CleanFileName = fileName
End Function

4. アーキテクトの視点：陥りやすい罠と回避策

このコードを読み解く際、単に「動けばいい」ではなく、以下の「プロが考慮しているポイント」に注目してください。

① ファイル名禁止文字のバリデーション (`CleanFileName`)

ここが最も重要です。送信者名に `株式会社A/B` のようにスラッシュが含まれていた場合、Windowsはそれを「フォルダの区切り」と誤認し、エラーを吐いて停止します。`CleanFileName` 関数でこれらを安全な文字（`_`）に置換しておくことは、堅牢なシステムを作る上での「必須の作法」です。

② 再帰的なフォルダ作成 (`CreateFolderRecursive`)

VBAの標準機能には「深い階層のフォルダを一気に作る」コマンドはありません。
`C:\A\B\C` を作りたいとき、まず `A` を作り、次に `A\B` を作り……という手順が必要です。このコードでは「再帰呼び出し」というテクニックを使い、親フォルダが存在するか確認しながら、最下層まで自動で掘り進めています。

③ ファイル名の衝突回避

同じ取引先から同じ名前のファイル（例：`invoice.pdf`）が届いた場合、上書きしてしまうとデータが消えてしまいます。コード内では `fso.FileExists` を使い、既に存在する場合はファイル名の頭に時間を付与することで、データを守る設計にしています。

まとめ：自動化の先にある「秩序」

いかがでしたでしょうか。

ただファイルを保存するだけのマクロと、今回のような「階層を理解し、エラーを予見し、秩序を持って保存するマクロ」の間には、決定的な差があります。

プログラミングにおいて、「例外（エラー）をいかに美しく処理するか」が、そのエンジニアの実力を物語ります。今回学んだFSOの活用と、禁止文字の処理、再帰的なフォルダ作成。これらをマスターすれば、あなたのOutlook VBAは、単なる道具から「信頼できるパートナー」へと昇華するはずです。

ここをクリアすれば、Outlook VBAの基本はバッチリですよ。
さあ、次はもっと複雑な、条件分岐に基づいた高度な自動化に挑戦していきましょう！応援しています。