近日,因工作上的需要,要求把每个邮箱所发出去的邮件都要自动密件抄送到一个指定的邮件地址,用OUTLOOK可以通过规则来处理自动抄送邮件到一指定的邮件地址,但却没有密件抄送这一项, 在网络上搜了一下,发现在EXCELHOME.NET论坛里也有人提过此问题, 这问题可以通过加载宏来达到目的.事不宜迟,赶紧复制到OUTLOOK里一
试,果然OK,有需要的朋友不妨一试.
 
打开OUTLOOK后,按ALT+F11
 
代码如下:(此代码转载自club.excelhome.net)
 
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 = " master@abc.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