在向Outlook中的外部域发送电子邮件之前发出警告

Question

Outlook如果您要发送并通过电子邮件发送到外部域,如何向您发出警告？

每天发送大量电子邮件总是可能错误地将错误的人发送给错误的人.当他们是客户或公司以外的人时,这尤其成问题.

使用Alt + Enter键入他们给我后快速发送邮件常常是因为我不彻底检查收件人的原因.

我发现了许多不太好的实现,所以我想我会在下面分享我的...

Answer 1

感谢ojhhawkins为上面的代码 - 非常有用.我做了一个简单的迭代,在MsgBox文本中包含一个外部电子邮件地址列表.

注意事项 - 我注意到当您在其他程序中使用"发送为电子邮件附件"时不会出现警告,例如Excel,Adobe Reader等.正如niton指出的那样:

回复:在其他程序中发送电子邮件附件.这里的注释描述outlookcode.com/d/code/setsavefolder.htm"...不适用于使用Office程序中的文件|发送命令或Windows资源管理器或其他程序中的类似命令创建的消息.这些命令调用简单MAPI,绕过Outlook功能."

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
    Dim recips As Outlook.Recipients
    Dim recip As Outlook.Recipient
    Dim pa As Outlook.PropertyAccessor
    Dim prompt As String
    Dim strMsg As String

    Const PR_SMTP_ADDRESS As String = "http://schemas.microsoft.com/mapi/proptag/0x39FE001E"

    Set recips = Item.Recipients
    For Each recip In recips
        Set pa = recip.PropertyAccessor
        If InStr(LCase(pa.GetProperty(PR_SMTP_ADDRESS)), "@example.com") = 0 Then
            strMsg = strMsg & "   " & pa.GetProperty(PR_SMTP_ADDRESS) & vbNewLine
        End If
    Next

    If strMsg <> "" Then
        prompt = "This email will be sent outside of example.com to:" & vbNewLine & strMsg & "Do you want to proceed?"
        If MsgBox(prompt, vbYesNo + vbExclamation + vbMsgBoxSetForeground, "Check Address") = vbNo Then
            Cancel = True
        End If
    End If
End Sub

要将此代码实际添加到Outlook应用程序:

• 如果在功能区栏中看不到"开发人员"选项卡,请转到" 文件/选项",选择左侧的" 自定义功能区 ",然后选择右侧的" 开发人员 ".
• 从Developer选项卡中选择Visual Basic.
• 展开Project1,Microsoft Outlook对象,然后双击ThisOutlookSession(左上角).
• 将上面的代码粘贴到模块中.
• 将复制的代码中的"example.com"替换为您的域.
• 关闭VBA编辑器并保存对模块的更改.
• 在" 开发工具"选项卡上,单击" 宏安全性",然后将级别更改为所有宏或更低的通知.
• 重启Outlook.(上面的代码不会初始化.)

Answer 2

1. 将以下代码添加到OutlookApplication_ItemSend中的事件并将域更改为您自己的域

2. 将其更改Macro Security为（所有宏的通知或启用所有宏）

如果您的 1 个或多个 或TO地址不在您的域中（例如下面），这将在发送前向您发出警告CCBCC@mycompany.com.au

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
    Dim recips As Outlook.Recipients
    Dim recip As Outlook.Recipient
    Dim pa As Outlook.PropertyAccessor
    Const PR_SMTP_ADDRESS As String = "http://schemas.microsoft.com/mapi/proptag/0x39FE001E"
    Set recips = Item.Recipients
    For Each recip In recips
        Set pa = recip.PropertyAccessor
        If InStr(LCase(pa.GetProperty(PR_SMTP_ADDRESS)), "@mycompany.com.au") = 0 Then
            If MsgBox("Send mail to external domain?", vbYesNo + vbQuestion + vbMsgBoxSetForeground, "Check Address") = vbNo Then
                Cancel = True
                Exit Sub
            Else
                Exit Sub
            End If
        End If
    Next
End Sub