Use this code to send a new message using the address the selected message was sent To as the send using From account.
See Using a Gmail Master Account: Reply using the Correct Account for instructions and a better set of macros to send using accounts linked to your Gmail account.
This code is for people who use an account such as Gmail or Hotmail to collect mail from other accounts and download only that account. Outlook will always reply using the account that downloaded the message, which is the Hotmail or Gmail account. You'll need to create an account in Outlook for the other addresses to use this code, but can set the accounts to never download email.
This code gets the address the message was sent to and looks for an existing account with the same display name and uses that account. If it can't find a matching account it uses the default account.
Update: I fixed the macro, it now checks for a specific string (an email address) in the To field. If it finds the address, the reply is from that address, otherwise the reply is from the default address. If you need to check for one of several accounts, you'll need to use an array.
To force the code to always use a specific non-default account, change this line:
objMsg.SendUsingAccount = olNS.Accounts.Item(1) to
objMsg.SendUsingAccount = olNS.Accounts.Item(2) where 2 is the placement of the account in the Account Settings list
or objMsg.SendUsingAccount = "Display name of desired account"
If you are using Exchange server and have Send as permission to the address a message was sent to (such as a distribution list), replace the For Each... Next block with:
objMsg.MailItem.Sender = oMail.To
objMsg.SentOnBehalfOfName = oMail.To
This may not work with Outlook 2013's "inline replies". Messages will be opened in a new Window.
Reply from the address a message was sent to
Public Sub AccountSelection() Dim oAccount As Outlook.Account Dim strAccount As String Dim olNS As Outlook.NameSpace Dim objMsg, oMail As MailItem Set olNS = Application.GetNamespace("MAPI") ' For a reply all version, replace Reply with ReplyAll Set objMsg = ActiveExplorer.Selection.Item(1).Reply If TypeName(ActiveExplorer.Selection.Item(1)) = "MailItem" Then Set oMail = ActiveExplorer.Selection.Item(1) On Error Resume Next For Each Recipient In oMail.Recipients strRecip = Recipient.Address & ";" & strRecip Next Recipient If InStr(strRecip, "email@example.com") = 1 Then ' StrAccount is the account name as shown in the Account Settings list strAccount = "firstname.lastname@example.org" Else End If For Each oAccount In Application.Session.Accounts If oAccount.DisplayName = strAccount Then objMsg.SendUsingAccount = oAccount Else ' to reply using the account that downloaded the message ' leave the objMsg line commented ' remove comment to reply using default account ' objMsg.SendUsingAccount = olNS.Accounts.Item(1) End If Next objMsg.Display Else End If Set objMsg = Nothing Set olNS = Nothing End Sub
How to use macros
First: You will need macro security set to low during testing.
To check your macro security in Outlook 2010 or 2013, go to File, Options, Trust Center and open Trust Center Settings, and change the Macro Settings. In Outlook 2007 and older, it’s at Tools, Macro Security.
After you test the macro and see that it works, you can either leave macro security set to low or sign the macro.
Open the VBA Editor by pressing Alt+F11 on your keyboard.
To put the code in a module:
- Right click on Project1 and choose Insert > Module
- Copy and paste the macro into the new module.
- Click Run to test the macro
When you're happy with the macro, create a ribbon or QAT button for the macro.
More information as well as screenshots are at How to use the VBA Editor