To automatically Bcc all outgoing messages
If you want to have Outlook 2000 automatically add a particular address as a Bcc to all outgoing items, put this VBA code in the built-in ThisOutlookSession module (Press Alt+F11 to get to the VBA development environment):
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim objMe As Recipient
Set objMe = Item.Recipients.Add("myaddress@mydomain.dom"
objMe.Type = olBCC
objMe.Resolve
Set objMe = Nothing
End Sub
Make sure you substitute the right e-mail address for "myaddress@mydomain.dom."
This second version that handles the case where you have the Outlook Email Security Update or Outlook 2002 and don't click Yes on the dialog that pops up or where you specify a name, rather than an SMTP address, for the Bcc recipient and the name cannot be resolved.
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim objRecip As Recipient
Dim strMsg As String
Dim res As Integer
' #### USER OPTIONS ####
' address for Bcc -- must be SMTP address or resolvable
' to a name in the address book
strBcc = "someone@somewhere.dom"
On Error Resume Next
Set objRecip = Item.Recipients.Add(strBcc)
' handle case of user canceling Outlook security dialog
If Err = 287 Then
strMsg = "Could not add a Bcc recipient " & _
"because the user said No to the security prompt." & _
" Do you want still to send the message?"
res = MsgBox(strMsg, vbYesNo + vbDefaultButton1, _
"Security Prompt Cancelled"
If res = vbNo Then
Cancel = True
Else
objRecip.Delete
End If
Err.Clear
Else
objRecip.Type = olBCC
objRecip.Resolve
If Not objRecip.Resolved Then
strMsg = "Could not resolve the Bcc recipient. " & _
"Do you want still to send the message?"
res = MsgBox(strMsg, vbYesNo + vbDefaultButton1, _
"Could Not Resolve Bcc Recipient"
If res = vbNo Then
Cancel = True
End If
End If
End If
Set objRecip = Nothing
End Sub
The two rules for success are:
1. Never tell them everything you know.