Question

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

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

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

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

Answer 1

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

提醒注意 - 我注意到当您在其他程序中使用“发送为电子邮件附件”时不会出现警告，例如Excel，Adobe Reader等。niton指出：

Re：在其他程序中发送电子邮件附件。这里的注释描述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

将以下代码添加到 Outlook ＆amp;中的Application_ItemSend事件中将域名更改为您自己的
将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

Answer 3

如果您不想使用VBA，我发现Outlook的两个加载项也是如此，

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

3 个答案: