Outlook发送邮件自动添加BCC

 Outlook发送邮件自动添加BCC

本文主要讲述如何自动添加BCC到outlook的收件人中，本文有在outlook2003和outlook2010中验证过可以使用，以下举例的贴图以2010为准。

1、 outlook默认没有显示宏的相关信息，所以需要进行设置。具体如下所示：

如上图所示，依次选择文件à选项，把开发工具这个菜单显示出来，勾选上之后点击确定保存。

2、 修改宏的安全级别

在第一步完成以后，重新打开outlook，此时可以在顶部看到开发工具，按照上图中所示，找到宏安全性，点击后按照个人的需求设定好。我的定义如下所示：

为所有宏提供通知的意思就是说当遇到有宏的时候，会提示你是否要启用，如果嫌麻烦可以选择启用所有宏，不过这样子可能会带来其他风险。最安全的就是第一个，不提供通知，禁用所有宏，这个是默认选项，但是如果选择这个的话，本文所要达到的目的也就没办法实现了。

3、 设定自动添加的BCC人员的邮件地址。

还是按照上图中所示，点击开发工具，不过这次不是点宏安全性了，点击旁边的Visual Basic，按照下图中所示输入代码：

PS：代码复制如下

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

strBcc = "[email protected]"

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

Set objRecip = Nothing

End Sub

完成之后保存所做修改，关闭outlook后重新打开，此时outlook会提示是否启用，点击启用即可。

若需要测试，只需写一封邮件，添加好收件者之后直接送出，然后再去BCC的邮箱即可看到该邮件。

经过测试，这段代码只可以BCC一个邮箱地址，如果有多个的话就不适用了。

下面这段代码跟上面那段代码的功能是一样的，同样是可以实现BCC的功能，只不过比较简洁，我个人比较喜欢

 

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

    Dim oItem As MailItem

    Dim oRecipient As Recipient

    Set oItem = Item

    ' 在这里参考如下代码根据需要增删BCC收件人

    Set oRecipient = oItem.Recipients.Add("[email protected]")

    oRecipient.Type = Outlook.olBCC

    oItem.Recipients.ResolveAll

    oItem.Save

    Set oRecipient = Nothing  

    Set oItem = Nothing

End Sub