Conditional Auto-BCC VBA

[Guest jarhed323]

Hi All,

I followed the really great tutorial on how to automatically include an email address in a BCC field from http://www.groovypost.com/howto/microsoft/how-to-automatically-bcc-in-outlook-2010/. My issue is this; I don't want to BCC ALL messages that are sent through Outlook (I'm using 2010 btw).

 

I have 2 exchange accounts I use (yes, 2010 lets you have more than 1 ). One of them is for support that is shared with others while the other is my personal account. When I send messages from the support address (SUPPORT_ACCOUNT@COMPANY.COM in the code), I need it to bcc my personal account in there. When I send from my personal account I do not need it bcc'ing personal inbox (redundancy is the worst form of recursion ).

 

The code below is mostly from the tutorial posted in the above link and what documentation I could find from the MSDN on MailItem Objects. I am a seasoned JAVA and PERL developer but lack any knowledge of VBA. Would someone kindly point out the error I've made below? It doesn't matter what account I send from at this point, it does not include the bcc. (I've checked the email address; it is correct, exists in my address book as well as global).

 

Thanks in advance,

James

 

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
Dim myOlApp As Outlook.Application
Dim myOlMsg As Outlook.MailItem

On Error Resume Next

' create outlook objects for referance
Set myOlApp = CreateObject("Outlook.Application")
Set myMsg = myOlApp.ActiveInspector.CurrentItem

' address to BCC
strBcc = "PERSONAL_ACCOUNT@COMPANY.COM"

' if the sender address is the support account utilize bcc
If myMsg.SenderEmailAddress = "SUPPORT_ACCOUNT@COMPANY.COM" 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
 Set objRecip = Nothing
End If

End Sub