BCC Emails from Outlook Script

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 = "email@email.co.uk"
   
    If InStr(Item.SendUsingAccount.SmtpAddress, "email.co.uk") <> 0 Then
        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
    End If

    Set objRecip = Nothing
End Sub