Outlook 2010 VBScript to CC or BCC in the inbox that is being sent from

[zines]

Hello,

I posted my question at the link http://www.groovypost.com/howto/microsoft/how-to-automatically-bcc-in-outlook-2010/ yesterday, but today that link is not working. What I want to do is slightly more complicated than what was posted at the link. Below is my original post.

What I am trying to do is create VBscript to CC or BCC (it doesn’t matter which) in the mailbox that I am sending from. I have a total of 5 mailboxes, including my personal and 4 shared boxes. I don’t want this applied to my personal or 1 of the shared, so I want to specify the mailbox names that it is being sent from. If it is one of the 3 it will place a copy of the email being sent into the inbox of the mailbox being sent from.

I know this can be easily done with creating rules, but we have shared mailboxes and due to how we log in, some people don’t like the rules and they uncheck them, very irritating. Also it appears there is no way to record a macro in Outlook, just create one.

I am trying to do something like this:

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)If From = "MailBox1@domain.com" Then    Forward.Recipients.Add "MailBox1@domain.com"End IfIf From = "MailBox2@domain.com" Then    Forward.Recipients.Add "MailBox2@domain.com"End IfIf From = "MailBox3@domain.com" Then    Forward.Recipients.Add "MailBox3@domain.com"End IfEnd Sub

I am not familiar with VBScript in Outlook at all, starting to get familiar with it in Excel though. Can someone please take a look at this and see if you know how to do this?

Thanks,

Chris

[Simon H]

I needed to restructure the code a little bit, the previous code would send it to the last mailbox that was listed when it was initially saved as a draft. I don't understand why since it even showed it didn't equal the last mailbox. I should have known better than to code it like that anyway, sloppy. The code below will work better and has structure to it.

Chris

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)Dim objRecip As RecipientDim strMsg As StringDim res As IntegerDim strBcc As StringOn Error Resume NextIf Item.SendUsingAccount = "mailbox1@domain.com" Then    strBcc = "mailbox1@domain.com"Else    If Item.SendUsingAccount = "mailbox2@domain.com" Then        strBcc = "mailbox2@domain.com"    Else        If Item.SendUsingAccount = "mailbox3@domain.com" Then            strBcc = "mailbox3@domain.com"        End If    End IfEnd IfSet objRecip = Item.Recipients.Add(strBcc)objRecip.Type = olBCCIf Not objRecip.Resolve Then    If res = vbNo Then        Cancel = True    End IfEnd IfSet objRecip = NothingEnd Sub

 

Nice answer I will keep a copy of this to use on some of my Outlook installations.

[zines]

This will allow you to BCC in whatever mailboxes you specify. Notice the section where it has “If” statements that looks like this:If strEmailAccount = "mailbox1@domain.com" Then strBcc = mailbox1@domain.comThere are 3 of these statements, just change the mailbox addresses to what you need. In my code below I have 3 mailboxes specified. If you only want 2 mailboxes, then delete an “If” statement, else if you want 4 mailboxes then add a statement. You can have as few or as many mailboxes you like. All you need to do is make an equivalent amount of “If” statements for each mailbox that you want to BCC.

This will also work when the email is first saved as draft. A lot of other codes will not work if the email was first opened from a draft, but this will. Please vote this answer up if it helps you.

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)Dim objRecip As RecipientDim res As IntegerDim strBcc As StringDim strMailCheck As StringDim strEmailAccount As StringstrMailCheck = "No"If Item.SendUsingAccount Is Nothing Then    strEmailAccount = Item.Parent.ParentElse    strEmailAccount = Item.SendUsingAccountEnd IfIf strEmailAccount = "mailbox1@domain.com" Then    strBcc = "mailbox1@domain.com"    strMailCheck = "Yes"Else   If strEmailAccount = "mailbox2@domain.com" Then        strBcc = "mailbox2@domain.com"        strMailCheck = "Yes"    Else        If strEmailAccount = "mailbox3@domain.com" Then            strBcc = "mailbox3@domain.com"            strMailCheck = "Yes"        End If    End IfEnd IfIf strMailCheck = "Yes" Then    Set objRecip = Item.Recipients.Add(strBcc)    objRecip.Type = olBCC    If Not objRecip.Resolve Then        If res = vbNo Then            Cancel = True        End If    End If    Set objRecip = NothingEnd IfEnd Sub

[Steve Krause]

This will allow you to BCC in whatever mailboxes you specify. Notice the section where it has “If” statements that looks like this:If strEmailAccount = "mailbox1@domain.com" Then strBcc = mailbox1@domain.comThere are 3 of these statements, just change the mailbox addresses to what you need. In my code below I have 3 mailboxes specified. If you only want 2 mailboxes, then delete an “If” statement, else if you want 4 mailboxes then add a statement. You can have as few or as many mailboxes you like. All you need to do is make an equivalent amount of “If” statements for each mailbox that you want to BCC.

This will also work when the email is first saved as draft. A lot of other codes will not work if the email was first opened from a draft, but this will. Please vote this answer up if it helps you.

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)Dim objRecip As RecipientDim res As IntegerDim strBcc As StringDim strMailCheck As StringDim strEmailAccount As StringstrMailCheck = "No"If Item.SendUsingAccount Is Nothing Then    strEmailAccount = Item.Parent.ParentElse    strEmailAccount = Item.SendUsingAccountEnd IfIf strEmailAccount = "mailbox1@domain.com" Then    strBcc = "mailbox1@domain.com"    strMailCheck = "Yes"Else   If strEmailAccount = "mailbox2@domain.com" Then        strBcc = "mailbox2@domain.com"        strMailCheck = "Yes"    Else        If strEmailAccount = "mailbox3@domain.com" Then            strBcc = "mailbox3@domain.com"            strMailCheck = "Yes"        End If    End IfEnd IfIf strMailCheck = "Yes" Then    Set objRecip = Item.Recipients.Add(strBcc)    objRecip.Type = olBCC    If Not objRecip.Resolve Then        If res = vbNo Then            Cancel = True        End If    End If    Set objRecip = NothingEnd IfEnd Sub

 

Great find @zines -- thanks for the follow-up! +1