让OUTLOOK2003自动密件抄送
近日,因工作上的需要,要求把每个邮箱所发出去的邮件都要自动密件抄送到一个指定的邮件地址,用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
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
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
转载于:https://blog.51cto.com/zinhaak/221881