首页 > 代码库 > VBA实现 Outlook 2010 自动密件抄送

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 = "XXX@XXX.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

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