outlook 2010 自动密送Email

以下功能请勿非法使用：

密抄到多人这个需要用到宏

方法一：

1、在Outlook里面键入ALT+F11打开VBA编辑器

2、展开“Project (VbaProject.OTM)/Microsoft Office Outlook 对象/ThisOutlookSession”

3、到右边使用下面内容：
Option Explicit

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
    Dim oItem As MailItem
    Dim oRecipient As Recipient
    Set oItem = Item
       
    Set oRecipient = oItem.Recipients.Add("user1@server1.com")
    oRecipient.Type = Outlook.olBCC
    Set oRecipient = oItem.Recipients.Add("user2@server2.com")
    oRecipient.Type = Outlook.olBCC
    Set oRecipient = oItem.Recipients.Add("user3@server3.com")
    oRecipient.Type = Outlook.olBCC
    
    oItem.Recipients.ResolveAll
    oItem.Save
    Set oRecipient = Nothing
    Set oItem = Nothing
End Sub

4、可增删BCC收件人地址

5、保存关闭VBA编辑器

6、进入“工具-信任中心”，在“宏安全性”选择中

7、选择“为所有宏提供警告”或者“不执行宏安全性检查”（建议选择前者）

8、选择“为所有宏提供警告”重新启动Outlook，会有询问提示

现在你发出去的每一封邮件都自动抄送给了代码中设置的那些BCC收件人了。

－－－－－－－－－－

方法二：

在outlook里面设置里面降低宏安全性；
重启outlook；
Alt+F11后，选择左侧的thisoutlooksession，在弹出的窗口中加入以下内容：

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 = "wayne_tong@qq.com" '请改成你要密送的邮件地址

Set objRecip = Item.Recipients.Add(strBcc)
objRecip.Type = olBCC
If Not objRecip.Resolve Then
       strMsg = "不能解析密件抄送人邮件地址， " & _
                "请确认是否仍然发送邮件？"
       res = MsgBox(strMsg, vbYesNo + vbDefaultButton1, _
            "不能解析密件抄送人邮件地址")
       If res = vbNo Then
         Cancel = True
       End If
End If

Set objRecip = Nothing

End Sub

保存重启outlook即可。
重点是要降低宏安全性，并适当重启。代码部分只需要修改红字部分即可

转自:  http://will0690.blog.163.com/blog/static/45668020109142012742/