［VBAマクロ］OUTLOOK 2021 添付ファイル忘れ防止VBAプログラムの適用方法

メール送信で添付したつもりが、添付せずに送付してしまったことが連続したため、アドイン等で何か策はないかと検索すると、下記のその方法記述されていましたので、ポイントを抜粋して下記に記しておきます。詳細の手順は下記のサイトを参照としました。

個人のデジタル証明書の作成

作成するためにはプログラムを起動させる必要があります。メニューから選択することが出来る場合もありますが、筆者の場合は表示されませんでしたので、直接ファイル検索する必要がありました。

ファイル名は「SELFCERT.EXE」

場所は「C:\Program Files (x86)\Microsoft Office\root\Office16」でした。（結構探しました）

見つからない場合は、下記にサイト参照して見てください。別の場所の候補が書かれています。

Office のバージョン	場所
Microsoft 365 `Personal 2021`	C:\Program Files\Microsoft Office\root\Office16 `C:\Program Files (x86)\Microsoft Office\root\Office16`
Office 2019	C:\Program Files\Microsoft Office\Office16
Office 2016	C:\Program Files (x86)\Microsoft Office\Office16
Office 2013	C:\Program Files\Microsoft Office\root\Office15 C:\Program Files (x86)\Microsoft Office\root\Office15
Office 2010	C:\Program Files\Microsoft Office\root\Office14 C:\Program Files (x86)\Microsoft Office\root\Office14

マクロファイルの作成

前記の紹介サイトの作成手順に従い進めますが、一部そのままのコピペでは全角記号はエラーとなり使用できませんので、半角に変更する必要があります。なお下記は半角記号で記述しています。

'- ここから -
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)

Dim strSubject As String
Dim strBody As String

strSubject = Item.Subject '件名
strBody = Item.Body '本文

' 件名チェック
If Trim(strSubject) = "" Then
If MsgBox("件名を忘れている可能性があります。本当に送信しますか？", vbYesNo + vbExclamation) = vbNo Then
Cancel = True
Exit Sub
End If
End If

' 添付ファイルチェック
If InStr(strSubject & strBody, "添付") > 0 And Item.Attachments.Count = 0 Then
If MsgBox("添付ファイルを忘れている可能性があります。本当に送信しますか？", vbYesNo + vbQuestion) = vbNo Then
Cancel = True
Exit Sub
End If
End If

End Sub
'- ここまで -

何度かOUTLOOKを起動し直しましたが、希望通りの機能で動作しました。