【Outlook VBA】テンプレートの件名をプレースホルダーで動的に制御する(日付自動付与)

はじめに

私の会社ではOffice365を使用しているので、
メールクライアントも必然的にOutlookとなります。

メールでの文書のやり取りは、
単発的なものもあれば一定のサイクルで定期的に送る必要があるものなどがあると思います。
後者のようなケースにおいてメール作成の手間をVBAを用いて解消できないだろうかといった点に着目したのが契機です。
メールの件名や本文には基本的なフォーマットは一緒だけれども、
部分的に変わる箇所(ex:日付情報など)が存在し、
単純にテンプレートファイルを用意するだけだと結局人の手で部分修正を行う必要が生じます。
今回はこのようなケースにおいて、動的に件名を変更しその手間を無くすマクロを以下の前提条件を従って作成します。

前提

・形式的なメールを毎月「10日」「20日」「月末」の計3回送信する必要がある。
・3つのメール本文の内容は同一を想定。
・メールの件名にはどのタイミングでの報告であるのかが一目でわかるように「N月度」「N日締め」といったような記載を行う。

実装方法

• Replaceメソッドを使用して件名内に含まれる特定の文字列を置換する。

テンプレートファイルを作成

まず元のメールとなるテンプレートファイルを作成します。
サンプルとして以下のような件名のメールを作成します。

件名

yyyy年mm月度調査報告書の提出(dd日締め).oft

拡張子oftのファイルはOutlookのテンプレートファイルを意味します。

yyyy,mmといった謎のアルファベットの羅列はVBAで置換する際に使用する仮の値です。
つまりプレースホルダーのようなものとなります。

仮変数	日付
yyyy	年
mm	月
dd	日

ソースコード

Dynamic_sub

Option Explicit

Sub DynamicSub()
'#############################################################################
'#<はじめに>
'#・#メールの件名の日付部分を動的に変更します。
'#・filePath:テンプレートファイルのパスを事前に埋め込んでください。
'#############################################################################
    ''''''''''''''''''''''''''''''''事前準備'''''''''''''''''''''''''''''''

    '事前変数宣言
    Dim year As String
    Dim month As String
    Dim day As String
    Dim filePath As String: filePath = "ファイルパス"
    Dim fso As Object: Set fso = CreateObject("Scripting.FileSystemObject")
    Dim bool
    
    '年月をFormat関数で整える
    year = Format(Date, "yyyy")
    month = Format(Date, "mm")
    day = Format(Date, "dd")
    
    '日付判定処理
    If day <= 10 Then
        day = 10
    ElseIf day <= 20 Then
        day = 20
    Else
        day = "月末"
    End If
    
    '''''''''''''''''''''''''''''''日付置換処理''''''''''''''''''''''''''''''
    
    'テンプレートファイルオープン
    bool = fso.FileExists(filePath)
    If bool Then
        Dim objItem As MailItem
        Set objItem = Application.CreateItemFromTemplate(filePath)
    Else
        MsgBox "テンプレートファイルが存在しません"
        GoTo Error
    End If
    
    '件名の置換
    objItem.Subject = Replace(objItem.Subject, "yyyy", year)
    objItem.Subject = Replace(objItem.Subject, "mm", month)
    objItem.Subject = Replace(objItem.Subject, "dd", day)
    
    '月末の場合のみ発生する不要な文字を削除する
    If day = "月末" Then
        objItem.Subject = Replace(objItem.Subject, "日", "")
    End If
    
    'メールのオープン
    objItem.Display
    Exit Sub
    
'エラー発生時
Error:
    MsgBox "エラーが発生したため処理を終了します"
    objItem.Close (olDiscard)
    Exit Sub
    
End Sub

ツール概要

• Date関数で年月日の情報を取得する。
• 取得した日付の情報から何日締めの報告用メール化を判定する。
• 対象テンプレートファイルの件名からプレースホルダーの値をDate関数で取得した値に置換。
• 月末報告の場合、「月末日締め」となるため、不要な文字を削除(月末日締め→月末締め)

補足

今回は月3回(10日、20日、月末)を想定しているが、
日報など日次で送信するメールにおいて、日付情報を載せる場合には、
if文による日付判定は不要。

メールの誤送信防止のためメールの送信処理は組み込んでいない。

備忘

• OutlookVBAの処理はバックグラウンドで実行されるためDisplayメソッドを使用しないとGUI上で表示されない。
• CloseメソッドはSaveModeというパラメータを指定する必要がある。
  今回は"(olDiscard)"を指定している。
  このパラメータは変更内容を破棄するもので、エラーによりメール作成が頓挫した場合に作成途中のメールを破棄するために記述している。
  尚、"MailItem.Close (1)"のように番号を指定してSaveModeを指定することも可能。

• Replaceメソッドでは正規表現を使用することができない(というよりVBA自体が正規表現に素直に対応していなかったはず...)
  そのため緻密なパターンマッチを行うことができない。
  事前に置換対象とする文字列(プレースホルダー)を含むテンプレートを用意しておき、それに対してシンプルなパターンマッチを適用する方法をとった。

余談

OutlookVBAで文書を自動作成するといったケースでは、
Excelと組み合わせて文書を作成するといった手法をよく見かけたのですが、
個人的にはOutlook単体で完結できるようにしたいといった思いがあり、
テンプレートとReplace関数を使用した方法を採用しました。

OutlookVBAはマニアックで情報も少ないです。
折角ですから自身の備忘録として残しておこうという点と、
他のOutlookVBAに興味を持った方の一助になればと思った次第です。

VBA自体そこまで詳しくないため、
冗長な書き方になっているかもしれません。
コードの問題点などありましたら是非ご指摘ください。