マクロが含まれる可能性がある Office ファイルを添付して送信しようとすると警告を表示するマクロ

最近、Emotet のような Office ファイルのマクロにより感染を広げるウイルスを防ぐため、マクロが含まれる Office の添付ファイルをブロックするというような組織が増えてきているようです。
そこで、マクロが含まれると判断される可能性がある拡張子の Office ファイルを送信する際に警告を表示し、送信をキャンセルすることができるマクロを作成しました。
マクロは以下の通りです。
なお、拡張子だけで判断しているので、実際にマクロが含まれていないファイルでも警告が表示される場合があります。

'
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
     On Error Resume Next
     CheckMacroAttachment Item, Cancel
End Sub
'
Private Sub CheckMacroAttachment(ByVal Item As Object, Cancel As Boolean)
     Const MACRO_EXTS = "docm;dotm;potm;ppam;ppsm;pptm;sldm;xlam;xlsb;xlsm;xltm;doc;dot;pot;ppa;pps;ppt;sld;xla;xls;xlt;"
     Dim strMacroFiles As String
     Dim objAttach As Attachment
     Dim strFileName As String
     Dim strExt As String
     '
     strMacroFiles = ""
     For Each objAttach In Item.Attachments
         strFileName = objAttach.FileName
         strExt = Mid(strFileName, InStrRev(strFileName, ".") + 1) & ";"
         If InStr(MACRO_EXTS, strExt) > 0 Then
             strMacroFiles = strMacroFiles & strFileName & vbCrLf
         End If
     Next
     '
     If strMacroFiles <> "" Then
         If MsgBox("以下の添付ファイルはマクロを含んでいる可能性があります。" & vbCrLf & _
             strMacroFiles & "メールを送信しますか?", vbYesNo) = vbNo Then
             Cancel = True
         End If
     End If
End Sub


マクロの登録方法やメニューへの追加について