Outlook 2010 - VBA - Set bcc in ItemSend

Question

Program: Outlook 2010
OS: Win8
VBA Skill: Novice

Notes:
This works perf

Answer 1

My possibly false impression is, at the time you wrote this, you did not know how to debug. This may have been helpful http://www.cpearson.com/Excel/DebuggingVBA.aspx

Here is a simplified untested version. I removed all the Else statements.

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
    'source:    http://www.outlookcode.com/article.aspx?id=72
    'source:    http://www.outlookforums.com/threads/89987-auto-bcc-vba-macro-how-add-exceptions/  (exceptions)  [2]
    'source:    http://www.groovypost.com/howto/microsoft/how-to-automatically-bcc-in-outlook-2010/#comment-312919 (sendusing) [3]


    Dim objRecip As Recipient
    Dim strMsg As String
    Dim res As Integer
    Dim strBcc As String

    '[2]
    If Item.Categories = "zBCC no" Then Exit Sub
    If Item.To = "personal@domain.com" Then Exit Sub
    If InStr(1, Item.Body, "zebra") Then Exit Sub

    If Item.To = "1@domain.com" Or Item.To = "2@domain.com" Then

        strBcc = "3@domain.com"
        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

        GoTo ExitRoutine

    End If

    '[3]
    If Item.SendUsingAccount = "Account Name here" Then

        strBcc = "special@domain.com"
        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

        GoTo ExitRoutine

    End If


    ' #### USER OPTIONS ####
    ' address for Bcc -- must be SMTP address or resolvable to a name in the address book

    strBcc = "1@domain.com"
    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
            GoTo ExitRoutine
        End If
    End If

    strBcc = "2@domain.com"
    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
            GoTo ExitRoutine
        End If
    End If

    strBcc = "3@domain.com"
    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

ExitRoutine:
    Set objRecip = Nothing

End Sub

When you debug you will note Item.SendUsingAccount is always blank.

You can try setting SendUsingAccount Use the mail account you want in your mail macro but it is a little trickier than SentOnBehalfOfName (From). Note manually setting From will not update SentOnBehalfOfName.

You can see how it works with this.

Sub SetSentOnBehalf()

Dim objMsg As MailItem

Set objMsg = Application.CreateItem(0)

objMsg.SentOnBehalfOfName = "bingo@bongo.com"

objMsg.Display

MsgBox " SentOnBehalfOfName in the From: " & objMsg.SentOnBehalfOfName

Set objMsg = Nothing

End Sub