Question

我继承了办公网络。我的目标是将mydomain.com的所有（传入和传出）电子邮件发送到外部地址some_email@external_domain.com

方案： mydomain.com的邮件服务器位于外部（无交换服务器）。客户端使用Outlook 2010进行POP并发送电子邮件。

- 每个电子邮件地址都有一个转发到服务器端的some_email@external_domain.com

- 每个Outlook 2010客户端都配置了：

Dim strBcc As String
On Error Resume Next
' #### USER OPTIONS ####
' address for Bcc -- must be SMTP address 
' or resolvable to a name in the address book
strBcc = "some_email@external_domain.com"
Set objRecip = Item.Recipients.Add(strBcc)
objRecip.Type = olBCC
If Not objRecip.Resolve Then
    strMsg = "Could not resolve the Bcc recipient. " & _
             "Do you want to send the message?"
    res = MsgBox(strMsg, vbYesNo + vbDefaultButton1, _
            "Could Not Resolve Bcc")
    If res = vbNo Then
        Cancel = True
    End If
End If

现在一切正常....除非用户从mydomain.com向mydomain.com发送电子邮件。当然，some_email@external_domain.com会收到两封电子邮件（来自自动BCC和服务器端转发）

我的问题：是否可以从自动BCC中排除*@mydomain.com？

Answer 1

经过一些反复试验后，我通过以下方式实现了这一目标：

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)

Dim objRecip As Recipient
Dim strMsg As String
Dim res As Integer
Dim strBcc As String
On Error Resume Next

If Item.To Like "*@mydomain.com" Or Item.CC Like "*@mydomain.com" Then
'Do nothing
Else
    strBcc = "some_email@external_domain.com"
    Set objRecip = Item.Recipients.Add(strBcc)
    objRecip.Type = olBCC
    If Not objRecip.Resolve Then
        strMsg = "Could not resolve the Bcc recipient. " & _
        "Do you want still 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 objRecip = Nothing

End Sub

除非＆＃34; To＆＃34;或＆＃34; CC＆＃34;包含＆＃34; @ mydomain.com＆＃34;。到目前为止我的测试工作正常。

这是我第一次修补VBA，不胜感激，看到任何意见/建议。

Outlook 2010自动BCC有例外

1 个答案: