有条件地阻止Outlook根据发件人和收件人地址发送电子邮件 [英] Conditionally Prevent Outlook from Sending Email Based on From and Recipient Addresses

问题描述

我在Outlook 2007中设置了多个邮件帐户(例如，johndoe @ domainA.com，johndoe @ domainB.com等).有时，通常是由于自动完成"功能的结果，我会错误地将邮件从[e-mail]发送给应该只从[e-mail]接收邮件的收件人.

I have multiple mail accounts setup in Outlook 2007 (e.g., [e-mail], [e-mail], etc.). Occasionally, usually as the result of the Auto Complete feature, I will mistakenly send email from [e-mail] to a recipient that should only be receiving mail from [e-mail]).

从(我选择的邮件帐户)和收件人(收件人"或抄送")电子邮件地址之间的这些限制通常可以通过域名来定义.

These restrictions between from (my selected mail account) and recipient (To or CC) email addresses can generally be defined by domain name.

例如，johndoe @ domainA.com不应发送到receive-domainX.com& receiver-domainY.com.并且[e-mail]不应发送到receive-domain1.com& receiver-domain2.com.

For example, [e-mail] should not send to recipient-domainX.com & recipient-domainY.com. And [e-mail] should not send to recipient-domain1.com & recipient-domain2.com.

因此最好在VBA脚本或文本文件中为每个邮件帐户明确定义或硬编码"这些域限制.

So it would be fine to explicitly define or "hardcode" these domain restrictions per mail account in a VBA script or text file.

因此，如果违反了其中一项限制，我如何使用VBA或其他方式对电子邮件地址进行检查，以防止发送电子邮件.

So how, using VBA or other means, can I implement a check of the email addresses, to prevent an email from being sent if one of these restrictions is being violated.

也可以使用其他更优雅的解决方案.

Open to other more elegant solutions as well.

谢谢.

推荐答案

这使您可以按地址筛选出电子邮件.我对此不能说太多，这主要是网上发布的几种不同的代码合并为一个.无论如何，它都能稳定运行，并且应该使您到达想要的位置的一半.在我们公司中，这用于将所有从外部发送的电子邮件发送到公共文件夹HR评论中.

This lets you screen emails out by address. I can't claim much credit for this, it's largely several different codes posted online merged into one. Regardless, it works solid and should get you half way to where you want to be. This is used in our company to send all externally sent emails into a public folder HR reviews.

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
    If Item.Class <> olMail Then Exit Sub
    Dim objMail As MailItem
    Set objMail = Item
    Dim NotInternal As Boolean
    NotInternal = False
    Dim objRecip As Recipient
    Dim objTo As Object
    Dim str As String
    Dim res As Integer
    Dim strBcc As String
    On Error Resume Next
    Const PidTagSmtpAddress As String = "http://schemas.microsoft.com/mapi/proptag/0x39FE001E"
    Dim i As Integer
    Dim objRecipColl As Recipients
    Set objRecipColl = objMail.Recipients
    Dim objOneRecip As Recipient
    Dim objProp As PropertyAccessor
    For i = 1 To objRecipColl.Count Step 1
        Set objOneRecip = objRecipColl.Item(i)
        Set objProp = objOneRecip.PropertyAccessor
        str = objProp.GetProperty(PidTagSmtpAddress)
        If Len(str) >= 17 Then  'Len of email address screened.  
            If UCase(Right(str, 17)) <> "@COMPANYEMAIL.COM" Then NotInternal = True
        Else
            NotInternal = True
        End If
    Next
    If NotInternal = True Then
        strBcc = "[e-mail]"
        Set objRecip = objMail.Recipients.Add(strBcc)
        objRecip.Type = olBCC
            If Not objRecip.Resolve Then
                strMsg = "Could not resolve the Bcc recipient. " & _
                         "Do you still want to send the message?"
                res = MsgBox(strMsg, vbYesNo + vbDefaultButton1, _
                        "Could Not Resolve Bcc Recipient")
                If res = vbNo Then
                    Cancel = True
                End If
            End If
    End If
    Set objRecipColl = Nothing
    Set objRecip = Nothing
    Set objOneRecip = Nothing
    Set objMail = Nothing
    Set objTo = Nothing
    Set oPA = Nothing
End Sub

这篇关于有条件地阻止Outlook根据发件人和收件人地址发送电子邮件的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！