To automatically Bcc all outgoing messages [Outlook 自動BCC]

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

' #### USER OPTIONS ####

' address for Bcc -- must be SMTP address or resolvable

' to a name in the address book

strBcc = "someone@somewhere.dom"

Set objRecip = Item.Recipients.Add(strBcc)

objRecip.Type = olBCC

If Not objRecip.Resolve 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

Set objRecip = Nothing

End Sub

Reference from : http://www.outlookcode.com/article.aspx?id=72