送信時に宛先をチェックし、選択により Bcc に移動するマクロ

コメントで以下のようなご要望をいただきました。

---

＠hotmail.co.jpでないアドレスが「宛先」に複数入っていた場合に送信ボタン を押すと、
警告「外部メールが宛先に入っています。BCCでなくても問題ないか再度確認してください」が表示される
→選択肢：1.このまま送信する、2.BCCに入れなおす
1.選択→通常通り送信される。
2.選択→BCCにアドレスが移動。

追記: 社外メールの宛先が「複数」含まれる場合に警告を表示し、選択によって BCC に移動するというマクロに変更は可能でしょうか？
「複数」＝2つ以上

---

下記のようなマクロで実現可能です。MY_DOMAIN で適切なドメインを指定します。

' ここをトリプルクリックでマクロ全体を選択できます。
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
    Const MY_DOMAIN = "*@hotmail.co.jp" ' 自組織のドメイン名を指定。@ の前に * を付ける
    Dim objRec As Recipient
    Dim cOut As Integer 
    Dim strOut As String
    Dim iRet As Integer
    ' 組織外の受信者が存在するかどうかの確認 
    cOut = 0 
    strOut = ""
    For Each objRec In Item.Recipients
        If objRec.AddressEntry.Type <> "EX" And objRec.Type <> olBCC Then
            If Not objRec.Address Like MY_DOMAIN Then 
                cOut = cOut + 1 
                strOut = strOut & objRec.Address & ";"
            End If
        End If
    Next
    ' 組織外の受信者が複数含まれていた場合の処理
    If cOut > 1 Then
        iRet = MsgBox("下記のメールアドレスは社外への送信になります。Bcc に移動しますか?" & _
        "移動する場合は [はい] を、移動しない場合は [いいえ] を、送信をやめる場合は [キャンセル]" & _
        "をクリックしてください。" & vbCrLf & strOut, vbYesNoCancel, "送信確認")
        Select Case iRet
            Case vbYes
                ' 社外の受信者を Bcc に移動
                For Each objRec In Item.Recipients
                    If objRec.AddressEntry.Type <> "EX" Then
                        If Not objRec.Address Like MY_DOMAIN Then
                            objRec.Type = olBCC
                        End If
                    End If
                Next
            Case vbNo
                ' 何もしない
            Case vbCancel
                Cancel = True
        End Select
    End If
End Sub

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