Outlook2016で送信する際に日付の入った本文や署名を送りたい時はないでしょうか?
署名として定型を入れておけば新規送信の際に6か月後の何時いつまでに破棄してくださいとか・・・の日付が自動で入ります。
ひと手間ですが、毎日沢山のメールを送るときには重宝すると思います。
それをVBAを使って実現します。
Outlookの準備
マクロをオンにします。
「ファイル」→ 「オプション」を選択します。

「トラストセンター」から「トラストセンターの設定」を選択します。

「マクロの設定」から「すべてのマクロを有効にする」を選択します。
これでVBAを受け付けるようになります。
※この設定は問答無用にマクロが実行されてしまうので安全なネットワークで実施しましょう。

署名側の設定
「ファイル」→「オプション」→「メール」から「署名」を選択します。

署名で署名本文に日付で
%%yyyy%%.%%mm%%.%%dd%%
※今回は現在日付の6か月後
を入れると 送信時に 「2022.3.10」のように整形されて送信されます。
署名を作成して保存します。

VBAの記述
開発タブのVBAで以下のようなプログラムを「ThisOutlookSession」へ記述します。

実際のVBA(プログラム)です。
Dim WithEvents myInspectors As Inspectors
' 起動時に上記のオブジェクトに設定
Private Sub Application_Startup()
Set myInspectors = Application.Inspectors
End Sub
' 新しいインスペクタが開かれた場合の処理
Private Sub myInspectors_NewInspector(ByVal Inspector As Inspector)
Dim strBody As String
Dim objItem
' 開かれたアイテムを取得
Set objItem = Inspector.CurrentItem
If objItem.MessageClass = "IPM.Note" Then ' アイテムがメール
If objItem.Sent = False Then ' アイテムが送信前
strBody = objItem.Body
' %%yyyy%% は 4 桁の年+6月
strBody = Replace(strBody, "%%yyyy%%", Year(DateSerial(Year(Now), Month(Now) + 6, Day(Now))))
' %%mm%% は現在+6月
strBody = Replace(strBody, "%%mm%%", Right("0" & Month(DateSerial(Year(Now), Month(Now) + 6, Day(Now))), 2))
' %%dd%% は日
strBody = Replace(strBody, "%%dd%%", Right("0" & Day(Now), 2))
If objItem.Body <> strBody Then objItem.Body = strBody
End If
End If
End Sub
実 行
作成後、いったんOutlookを再起動して「新規メール」を作成します。
署名欄には「 %%yyyy%%.%%mm%%.%%dd%% 」が記載されています。

送信先、件名、本文を入れて「送信」をします。

送信されたメールを見ると「 %%yyyy%%.%%mm%%.%%dd%% 」が変換されているのが分かります。
これで毎回、6か月後の日付を手入力でいれる必要がなくなります。
