Example VBA Macro - To Conditionally Change the From Account and Add a BCC Address on Emails

[Steve Tomalin]

I have just completed a VBA macro, which intercepts all new emails I create or replies I generate from received emails (regardless of whether Reply, Reply-All or Forward has been clicked). The macro conditionally changes the default From Account to a different value and also adds a BCC address to select emails I send. Having used example code provided by Sue Mosher (plus others) and having received further assistance from Diane Poremsky here, in order to get this working properly, I volunteered to post my finished macro on this forum, including an explanation for what it does and why I needed it, hence this post. Hopefully, this example might come in handy, in one way or another, to someone else who may be attempting to achieve the same or similar objectives.

If you do require further explanation about what the macro does, or the background as to why I needed it, that information is included after the example code. I would not classify myself as a developer, so if you try to use the macro yourself and encounter any problems getting it working, I'm afraid it's probably unlikely that I will be able to assist you.


Private WithEvents m_Inspectors As Outlook.Inspectors
Private WithEvents m_Inspector As Outlook.Inspector

Private Sub Application_Startup()
Set m_Inspectors = Application.Inspectors
End Sub

Private Sub m_Inspectors_NewInspector(ByVal Inspector As Outlook.Inspector)
Set m_Inspector = Inspector
End Sub

Private Sub m_Inspector_Activate()

If TypeName(m_Inspector.CurrentItem) = "MailItem" And _
m_Inspector.CurrentItem.Sent = False Then

Dim objMail As Outlook.MailItem
Dim OutApp As Outlook.Application
Set OutApp = Application
Set objMail = m_Inspector.CurrentItem

Dim strFrom1 As String
Dim strFrom2 As String
strFrom1 = "fred.bloggs@outlook.com"
strFrom2 = "fred.bloggs_other@outlook.com"

Dim strAccItem1 As String
Dim strAccItem2 As String
strAccItem1 = "5"
strAccItem2 = "6"

If objMail.Sent = False Then
If InStr(LCase(objMail.SendUsingAccount), strFrom1) Then

objMail.SendUsingAccount = OutApp.Session.Accounts.Item(strAccItem1)

With objMail
Set objRecip = objMail.Recipients.Add(strFrom1)
objRecip.Type = olBCC
objRecip.Resolve
End With

ElseIf InStr(LCase(objMail.SendUsingAccount), strFrom2) Then

objMail.SendUsingAccount = OutApp.Session.Accounts.Item(strAccItem2)

With objMail
Set objRecip = objMail.Recipients.Add(strFrom2)
objRecip.Type = olBCC
objRecip.Resolve
End With

End If
End If
End If

Set m_Inspector = Nothing

End Sub


What this Macro Does

Whenever I create a new email, or respond to an existing email using Reply, Reply-All or Forward, the macro runs. The macro tests the current value of the 'From' account in the open email and, if the 'From' value matches one of two particular values, it changes the From account value to one of two different values. In other words, (using the above example strings):

If the Display Value of the Send Account is currently 'fred.bloggs@outlook.com' in the open email, the macro changes the Send Account to the Account with the Item Value of 5. After that, fred.bloggs@outlook.com is added as a recipient to the BCC list.

Otherwise, if the Display Value of the Send Account is currently 'fred.bloggs_other@outlook.com' in the open email, the macro changes the Send Account to the Account with the Item Value of 6. After that, fred.bloggs_other@outlook.com is added as a recipient to the BCC list.

If the Display Value of the Send Account within the open email is anything else, the macro ends, changing nothing.


Why The Macro Was Needed

My requirement for this macro centred around the changes Microsoft made to Outlook.com, a year or so ago, when they swapped the original back end of Outlook.com for an Exchange based solution. In doing this, they ended providing full support for 'Custom Domains' within Outlook.com accounts and, instead, recommended that affected users should subscribe to an Office365 account. I resisted this approach and opted to deploy a different workaround instead.

There may very well be other approaches in solving what is/was the underlying problem here, but the approach I took seems to have been working quite well for me, with exception to an annoying manual step which, up until now, I had previously needed to perform on every email that I'd been sending from the custom domain email addresses associated with my Outlook.com accounts. That is why I needed the macro, to eliminate the manual intervention required when sending emails from Outlook on my PC. Not only was this repetitive, manual intervention inconvenient, but if inadvertently omitted, it merely emphasised the problem and could confuse the recipients of these errant emails into using the wrong email address(es) to communicate with me. The macro solves this issue.


Further Detail Regarding the Problem Which Necessitated the Workaround

I have used a couple of Outlook.com accounts as my email back end for the last few years. Each of these accounts had a 'Custom Domain' linked to the account as a Send Account and the Primary Alias of each account was my email address for the custom domain. All my email was sent as the Primary Aliases and (without close analysis of the email header information) none of the recipients of my emails would have been immediately made aware of any Outlook.com email accounts or addresses involved. When Microsoft upgraded their back end, the problem that arose for me affected all the emails that I sent from Outlook on my PC. The 'From' address details within the emails I was sending out to people suddenly started to include a statement along the lines of:

'From outlook_d32c5a9f8hf7ea66@outlook.com on behalf of Fred@Bloggs.me'

After various attempts and different approaches at fixing this, including creating new Outlook aliases for myself and changing my Primary Aliases within the accounts, this still only marginally improved the situation, resulting in a revised statement along the lines of:

"From Fred.Bloggs@Outlook.com on behalf of Fred@Bloggs.me"

I didn't want to advertise my Outlook.com email addresses, so this outcome was still completely unacceptable. In the case of my Outlook.com phone app and the Outlook.com webmail interface, there was/is still an option to select an alternative 'From' address within the emails that I send. The resultant emails do not include the 'sent on behalf of' statement within the From information, when received by the recipients, so I find this acceptable.


The Workaround

Using the dummy addresses quoted above as the example here, I still have the following email forwards set up within the host settings of my two custom domains:

Fred@Bloggs.me forwards to Fred.Bloggs@Outlook.com
Fred@BloggsOther.com forwards to Fred.Bloggs_Other@Outlook.com

Within Outlook on my PC, I still have the two Outlook.com accounts set up as IMAP accounts, where I receive all my incoming mail for my custom domain email addresses. However, I do not send mail out from these Outlook mailbox accounts. For that purpose I have two additional Send Only accounts configured within Outlook (Account Item Numbers 5 & 6), where I have specified the email address details and SMTP settings of the server I use to send out email for the Fred@Bloggs.me and Fred@BloggsOther.com addresses.

This arrangement solves the problem of ensuring that all emails sent out from Outlook on my PC are presented in exactly the way I want them to appear to the recipients. However, it introduced the problem of how to provide easy access to these sent emails within Outlook on my phone or within the Outlook.com webmail interface (which I occasionally need to do).

To solve this secondary issue, I simply ensure that all email sent from Outlook on my PC has my Outlook.com email address BCC'd on these items (I bought a utility to do this originally, but now the macro does this, as well as change the 'From' account). There is a rule configured within each of my Outlook.com accounts, so that any email arriving, where the sender is my own 'Custom Domain' email address, is moved into a Folder called 'PC Sent Items'.



That's about it! Some may consider it a bit 'clunky', but it works for me and avoided the need for me to pay for the monthly subscription to an Office365 account. The macro consequently automatically sets the correct From Account and adds the BCC address for every email I create or reply to that is sent from Outlook on my PC.

I hope some of this helps someone, at some point. Thanks again to Diane Poremsky, here on this forum, for all the help she gave me whilst I developed this macro.


Kind regards,

Steve Tomalin

 

[Steve Tomalin]

I encountered a bug in the above macro, today. Upon opening an unfinished email from either 'Drafts' folder, within the special 'Send Accounts' that I use, the macro would crash with the following error:

Run-time error '91'
Object variable or With block variable not set

Below is the line that was causing the problem and the reason the error occurred seemed to be because objMail.SendUsingAccount was ending up a value of 'Nothing', under this scenario.

If InStr(LCase(objMail.SendUsingAccount), strFrom1) Then

This issue seems to arise as a direct result of having automatically changed the SendFromAccount value, when the email was first created (i.e. before it was saved to the Drafts folder). I proved this by creating new emails from the Inbox of the two send accounts (rather than my two default inboxes) and then saving the messages to their respective Drafts folders. In both cases, there was no issue when the email was re-opened from the Drafts folders under those circumstances. There is apparently something that Outlook doesn't like, in certain situations, about creating an email under one account and then effectively moving it to another account by changing the SendFromAccount.

On the basis that any emails within these Drafts folders would have already been processed by my macro previously, I realised there was no need to re-run it on these items. I have consequently avoided the issue by inserting a test to find the name of the current folder. The macro now stops executing if it finds that the name of the current folder is Drafts. Below is the revised code.

Kind regards,

Steve

Private WithEvents m_Inspectors As Outlook.Inspectors
Private WithEvents m_Inspector As Outlook.Inspector

Private Sub Application_Startup()
Set m_Inspectors = Application.Inspectors
End Sub

Private Sub m_Inspectors_NewInspector(ByVal Inspector As Outlook.Inspector)
Set m_Inspector = Inspector
End Sub

Private Sub m_Inspector_Activate()

If TypeName(m_Inspector.CurrentItem) = "MailItem" And _
m_Inspector.CurrentItem.Sent = False Then

Dim objMail As Outlook.MailItem
Dim OutApp As Outlook.Application
Set OutApp = Application
Set objMail = m_Inspector.CurrentItem

Dim strFrom1 As String
Dim strFrom2 As String
strFrom1 = "steve.tomalin@outlook.com"
strFrom2 = "steve.tomalin_uats@outlook.com"

Dim strAccItem1 As String
Dim strAccItem2 As String
strAccItem1 = "5"
strAccItem2 = "6"

If objMail.Sent = False Then

Dim MyCurrentFolder As Outlook.MAPIFolder
Set MyCurrentFolder = Application.ActiveExplorer.CurrentFolder

If InStr(LCase(MyCurrentFolder), "drafts") Then
'Do nothing
Else
If InStr(LCase(objMail.SendUsingAccount), strFrom1) Then

objMail.SendUsingAccount = OutApp.Session.Accounts.Item(strAccItem1)

With objMail
Set objRecip = objMail.Recipients.Add(strFrom1)
objRecip.Type = olBCC
objRecip.Resolve
End With

ElseIf InStr(LCase(objMail.SendUsingAccount), strFrom2) Then

objMail.SendUsingAccount = OutApp.Session.Accounts.Item(strAccItem2)

With objMail
Set objRecip = objMail.Recipients.Add(strFrom2)
objRecip.Type = olBCC
objRecip.Resolve
End With

End If
End If
End If
End If
Set m_Inspector = Nothing
End Sub

 

[Steve Tomalin]

I bumped into another bug in the above VBA macro today. It turned out that opening anything other than an email would produce the runtime error:

run time error 438 - object doesnt support this property or method

I discovered the problem was down to the following line:

If TypeName(m_Inspector.CurrentItem) = "MailItem" And _
m_Inspector.CurrentItem.Sent = False Then

I figured that because there are effectively two conditional tests within this one this line, as a result of the 'And', it turns out that the m_Inspector.CurrentItem.Sent object is not valid for anything other than a mail item, thus causing the error. Even if the TypeName test returns False, it would seem the VBA interpreter still attempts to test both values, before deciding upon what path to take through the macro. It would appear that these two conditional tests cannot, therefore, be combined within a single line. I worked around this by turning the single If statement into two separate If statements and adding an additional End If at the end of the macro. So the previous, erroring line has been replaced with what is the basis of the following example:

If TypeName(m_Inspector.CurrentItem) = "MailItem" Then
If m_Inspector.CurrentItem.Sent = False Then
'Do the required stuff here to the email
End If
End If

I probably should not have posted my example macro until I'd been using it for a few weeks. Bit late for that now though, so apologies for that and I will just have to continue to post any other necessary fixes as I find problems that cause the macro to crash when running on my machine.

Kind regards,

Steve

 

[Diane Poremsky]

Even if the TypeName test returns False, it would seem the VBA interpreter still attempts to test both values, before deciding upon what path to take through the macro.

I wasn't aware of this...definitely not what you'd expect - which is to jump out if the first condition is false.

i wonder if one line with () would fail too:
If (TypeName(m_Inspector.CurrentItem) = "MailItem" And _
m_Inspector.CurrentItem.Sent = False) Then

I probably should not have posted my example macro until I'd been using it for a few weeks.

Not a problem - it can be a learning experience for others too.

 

[Michael Bauer]

() doesn´t help, VBA always checkes all conditions.

 

[Diane Poremsky]

Thanks michael, was hoping you'd chime in.

 

[Steve Tomalin]

After having an Outlook nightmare, yesterday, I thought I should explain the significance of where this example VBA macro needs to exist in Outlook's VBA environment, in order for it to work.

As a result of a corruption that arose in my OST file, I was unfortunate enough to need to remove and re-add one of my Outlook.com accounts within Outlook, yesterday. This caused the Account Item Numbers to change within Outlook, meaning the macro, which is the topic of this thread, needed to be updated. Before doing that, however, I found I needed to be able to identify the up-to-date acount numbers and, in my attempts to do that, I inadvertently messed up the whole set-up!

I'd previously used the following code, which I'd found on the web, to identify the account numbers:

Sub Which_Account_Number()
'Don't forget to set a reference to Outlook in the VBA editor
Dim OutApp As Outlook.Application
Dim I As Long

Set OutApp = CreateObject("Outlook.Application")

For I = 1 To OutApp.Session.Accounts.Count
MsgBox OutApp.Session.Accounts.Item(I) & " : This is account number " & I
Next I
End Sub

Because I know very little about Outlook, it seems that I completely destroyed my other macro/s, in creating what I had hoped would be a temporary macro to identify the account numbers.

In my struggles to get the original macro/s working again, I think I made a complete mess of my Outlook VBA environment, which I figured I needed to restore as per Outlook's 'Out-of-the-box' state. After a bit of research, I decided to search for the file 'VBAProject.OTM' within my Windows profile and to delete it. After Outlook re-created this file for me, this certainly seemed to go some way towards restoring things to how they had originally been.

ThisOutlookSession
The most important thing that I hadn't previously appreciated is that the example macro has to reside in the Outlook Object 'ThisOutlookSession' in order for it to work, which I eventually located using the Project Explorer, found under the View menu.

Once I had recreated the macro in ThisOutlookSession, the situation began to improve, other than it appeared to highlight another bug in the macro, due to a variable not having been previously declared. I'm not even sure how/why it worked originally, but that is now fixed. Seeing as I have made a couple of changes recently, here is the latest version:


Option Explicit

Private WithEvents m_Inspectors As Outlook.Inspectors
Private WithEvents m_Inspector As Outlook.Inspector

Private Sub Application_Startup()
'MsgBox "Application_Startup running"
Set m_Inspectors = Application.Inspectors
End Sub

Private Sub m_Inspectors_NewInspector(ByVal Inspector As Outlook.Inspector)
'MsgBox "m_Inspectors_NewInspector running"
Set m_Inspector = Inspector
End Sub

Private Sub m_Inspector_Activate()
'MsgBox "m_Inspector_Activate running"

If TypeName(m_Inspector.CurrentItem) = "MailItem" Then
If m_Inspector.CurrentItem.Sent = False Then

Dim objMail As Outlook.MailItem
Dim OutApp As Outlook.Application
Set OutApp = Application
Set objMail = m_Inspector.CurrentItem
Dim objRecip As Recipient

Dim strFrom1 As String
Dim strFrom2 As String
strFrom1 = "fred.bloggs@outlook.com"
strFrom2 = "fred.bloggs_other@outlook.com"

Dim strAccItem1 As String
Dim strAccItem2 As String
strAccItem1 = "5"
strAccItem2 = "6"

'Temp insert starts here, to re-identify account Nos., should they change as a result of changes to accounts settings.
'Dim I As Long
'Set OutApp = CreateObject("Outlook.Application")
'For I = 1 To OutApp.Session.Accounts.Count
'MsgBox OutApp.Session.Accounts.Item(I) & " : This is account number " & I
'Next I
'End of Temp insert

If objMail.Sent = False Then

Dim MyCurrentFolder As Outlook.MAPIFolder
Set MyCurrentFolder = Application.ActiveExplorer.CurrentFolder

If InStr(LCase(MyCurrentFolder), "drafts") Then
'Goto end of macro, as it will have previously run on items in Drafts in any case and,
'for some unknown reason, the macro crashes on items in Drafts!
Else
If InStr(LCase(objMail.SendUsingAccount), strFrom1) Then

objMail.SendUsingAccount = OutApp.Session.Accounts.Item(strAccItem1)

With objMail
Set objRecip = objMail.Recipients.Add(strFrom1)
objRecip.Type = olBCC
objRecip.Resolve
End With

ElseIf InStr(LCase(objMail.SendUsingAccount), strFrom2) Then

objMail.SendUsingAccount = OutApp.Session.Accounts.Item(strAccItem2)

With objMail
Set objRecip = objMail.Recipients.Add(strFrom2)
objRecip.Type = olBCC
objRecip.Resolve
End With

End If
End If
End If
End If
End If
Set m_Inspector = Nothing
End Sub

 

[Diane Poremsky]

Rather than using account #, use account names - then it doesn't matter what order they are in.

For Each oAccount In Application.Session.Accounts
   If oAccount = "me@domain.comt" Then
     oMail.SendUsingAccount = oAccount
   End If
Next

(my variable names might not match yours)

 

[LittleJack]

Hi Steve and Diane,
Unfortunately while a power user of Outlook, I only do so as a GUI-er.
I have zero VB knowledge and frankly would not know how/where to insert a script.

I would so like to utiltize most of Steve's phenomenal script as I too have the need to have inbound TO email addresses automatically change to a customized Default FROM email address upon Reply/ReplyAll/Forward - - although I don't need the BCC.

So couple of questions:
1. Diane added some code in the above post - could you re-present the entire VB script with the changes she offered so the whole script presents complete?
2. In looking at the script, I am still not entirely sure where to put the CONDITIONS of the inbound TO addresses and the change to outbound FROM address. When representing the script, could you make the first conditional email "INBOUNDTO@DOMAIN.com" and the custom FROM switch (which would auto change to) "CUSTOMFROM@DOMAIN.com"
3. Can someone explain as to how to add the script into Outlook 2016 as someone who does not speak coding language?


Super appreciate it.
Thanks,

 

[LittleJack]

Hi Steve,

Quick question - I'm having someone take a shot at building the script for me with a few changes. He mentioned that "the code will always be "on" or "running", so I'll need a lot of ram/resources, on your machine" - - can you corroborate such - - can you advise how much RAM you are running on your machine? - Thanks and Best Regards

 

[Diane Poremsky]

He mentioned that "the code will always be "on" or "running", so I'll need a lot of ram/resources, on your machine" -

True for the first part, but not for the second. It shouldn't be noticeable, unless you send a lot of mail really fast - the macro sits in the background and watches for a new item then runs for a split second.

I have 5 mailboxes in my profile and several auto-macros - outlook uses about 200 MB when its idle... a little more when i'm actively working in it.

 

[Diane Poremsky]

I would so like to utiltize most of Steve's phenomenal script as I too have the need to have inbound TO email addresses automatically change to a customized Default FROM email address upon Reply/ReplyAll/Forward - - although I don't need the BCC.

is the inbound address set up as an account in Outlook and downloading mail?

If it's listed as an account and downloads mail, and you want all mail to be sent from another account, you can change the smtp settings if its pop3 or imap.

The instructions are here - How to create a send-only POP3 account -
Steps 4 - 6:
the name and address at (1) on the screenshot will be the sending name and address.
use the correct pop server (or imap)
use the other account's smtp server
use the pop logon at (3)

Steps 8, 9:
Under more settings, outgoing server, use the correct account for the smtp server

skip the rest of the article.

if the account is collecting mail from multiple addresses and you want some to be sent from a different account based on the address it was sent to, you'll need to use a macro.