RSSUse this code to send a new message using the address the selected message was sent To as the send using From 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
or
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, "alias@domain1.com") = 1 Then
' StrAccount is the account name as shown in the Account Settings list
strAccount = "alias@domain1.com"
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
