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

Question

如果您要向外部域发送和发送电子邮件，如何让Outlook 发出警告？

每天发送大量电子邮件，总是有可能将一封错误地发送给错误的人。当他们是您公司以外的客户或人员时，这尤其是一个问题。

在为我输入电子邮件后使用Alt + Enter 快速发送电子邮件通常是原因，因为我没有彻底检查收件人。

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

Answer 1

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

注意事项 - 我注意到当您在其他程序（例如 Excel、Adobe Reader 等）中使用“作为电子邮件附件发送”时不会出现警告。正如 niton 指出的那样：

Re:在其他程序中以电子邮件附件形式发送。在此处的注释中有说明 outlookcode.com/d/code/setsavefolder.htm “...不适用于使用 File | Send 命令在 Office 程序或 Windows 资源管理器或其他程序中的类似命令创建的消息。这些命令调用 Simple 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 应用程序中：

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

Answer 2

如果您不想使用 VBA，我发现了两个 Outlook 加载项，它们的作用相同，

• www.safesendsoftware.com 和
• www.sperrysoftware.com.

Answer 3

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

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

如果您的TO、CC 或BCC 地址中有一个或多个不在您的域中（例如@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