Public Sub BCC(Item As Outlook.MailItem)

Dim objRecip As Recipient
Dim strMsg As String
Dim res As Integer
Dim BCC_ADDR As String
On Error Resume Next

BCC_ADDR = "email@email.com"

Set objRecip = Item.Recipients.Add(BCC_ADDR)
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

`Public Sub BCC(Item As Outlook.MailItem)
     Dim objRecip As Recipient
     Dim strMsg As String
     Dim res As Integer
     Dim BCC_ADDR As String
     Dim forward as MailItem
     On Error Resume Next
     BCC_ADDR = "email@email.com"
     Set forward = Item.Forward
     Set objRecip = forward.Recipients.Add(BCC_ADDR)
     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
     Else
        foward.Send
     End If
     Set objRecip = Nothing
End Sub`