VBA实现 Outlook 2010 自动密件抄送

实现密件抄送方式有很多种，多数的方法为设置Outlook规则。这里讲尝试使用VBA来实现此功能。

1、打开Outlook 2010 ，使用快捷键 ALT + F11 ，如下图：

2、刚开始左侧 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 = "[email protected]"
    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

其中XXX@XXX填写你想要默认密件抄送的邮件地址即可。