宛先や Cc に複数のドメインが混在していた場合に警告を表示するマクロ

メールの宛先に複数の受信者を設定する際、誤って別のドメインのアドレスを指定してしまうと、単に誤送信したというだけでなくアドレス情報の漏えいという話になる場合があります。
そこで、単に外部アドレスに送信するときに警告を出すというのではなく、宛先や Cc に複数のドメインが混在していた場合にだけ警告を出すというマクロを作ってみました。 警告を出すだけでなく、1分後に送信という遅延配信設定をするため、誤って [OK] をクリックしても 1 分以内に送信トレイから削除すれば誤送信が防げます。
マクロは以下の通りです。

' ここをトリプルクリックでマクロ全体を選択できます。
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
    Const MY_DOMAIN = "*@example.com" ' 自組織のドメイン名を指定。@ の前に * を付ける
    Dim objRec As Recipient
    Dim str1stDomain As String
    Dim bOut As Boolean
    Dim bMixed As Boolean
    Dim strOut As String
    Dim iRet As Integer
    ' 組織外の受信者が複数存在するかどうかの確認
    bMixed = False
    strOut = ""
    str1stDomain = ""
    For Each objRec In Item.Recipients
        If objRec.AddressEntry.Type <> "EX" Then
            If Not objRec.Address Like MY_DOMAIN AND Instr(objRec.Address, "@") > 0 Then
                strOut = strOut & objRec.Address & ";"
                If str1stDomain = "" Then
                    str1stDomain = "*" & Mid(objRec.Address, InStr(objRec.Address, "@"))
                ElseIf Not objRec.Address Like str1stDomain Then
                    bMixed = True
                End If
            End If
        End If
    Next
    ' 組織外の受信者が複数含まれていた場合の処理
    If bMixed Then
        iRet = MsgBox("あて先に複数のドメインのメールアドレスが含まれています。送信しますか?" & _
            vbCrLf & "外部ドメイン宛: " & strOut, vbYesNo, "送信確認")
        Select Case iRet
            Case vbYes
                ' 送信日時を 1 分後に設定
                Item.DeferredDeliveryTime = DateAdd("n", 1, Now)
                Cancel = False ' 念のため
            Case vbNo
                Cancel = True
        End Select
    End If
End Sub


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