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

Question

你怎么能得到Outlook如果您要向外部域发送电子邮件并发出警告？

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

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

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

Answer 1

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

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

Re:Send As Email Attachment in other programmes. Described in notes here outlookcode.com/d/code/setsavefolder.htm "... does not work on messages created with File | Send commands in Office programs or similar commands in Windows Explorer or other programs. Those commands invoke Simple MAPI, which bypasses Outlook functionality."

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 编辑器并保存对模块的更改。

在 Developer 选项卡上单击 Macro Security，然后将级别更改为所有宏的通知或更低。

重新启动 Outlook。 (否则上面的代码不会初始化。)