When a mailbox receives messages for more than one address, such as messages forwarded from another account, Outlook may include the address in the recipients list when you hit Reply All.
I have an issue with reply all in outlook 2013. Since I use gmail, I effectively have 2 email addresses, with the same account (@gmail.com, @googlemail.com) If I reply all to an email sent to @googlemail.com, I get cc'd on the reply as outlook doesn't recognize the address as the same as the account its set up with.
This isn't a new problem: Outlook has always had problems identifying which address is yours when it doesn't match the address on your account in Account Settings.
To remove the address, use a macro that runs when you trigger the Reply All command.
Paste the following macro in ThisOutlookSession. To test it without restarting Outlook, click in the Startup macro and press F5 or the Run button.
This macro will be triggered by the Reply All button in the Reading Pane but the reply opens in a new window.
Option Explicit
Private WithEvents oExpl As Explorer
Private WithEvents oItem As MailItem
Private bDiscardEvents As Boolean
'//slipstick.me/44b0w
Private Sub Application_Startup()
Set oExpl = Application.ActiveExplorer
bDiscardEvents = False
End Sub
Private Sub oExpl_SelectionChange()
On Error Resume Next
Set oItem = oExpl.Selection.Item(1)
End Sub
' Reply
Private Sub oItem_ReplyAll(ByVal Response As Object, Cancel As Boolean)
Cancel = True
bDiscardEvents = True
Dim oReply As MailItem
Set oReply = oItem.ReplyAll
Dim recips As Outlook.Recipients
Dim i As Long
Set recips = oReply.Recipients
For i = recips.Count To 1 Step -1
If LCase(recips.Item(i).Address) = "alias@slipstick.com" Then
recips.Remove i
End If
Next
oReply.Display
bDiscardEvents = False
Set oItem = Nothing
End Sub
How to use the macro
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 use the macro code in ThisOutlookSession:
- Expand Project1 and double click on ThisOutlookSession.
- Copy then paste the macro into ThisOutlookSession. (Click within the code, Select All using Ctrl+A, Ctrl+C to copy, Ctrl+V to paste.)
More information as well as screenshots are at How to use the VBA Editor
More Information
See E-Mail: Remove recipients before sending code sample by Outlook Developer MVP Michael Bauer. Michael's code checks for more than one address.
I'm on Outlook 365 / Windows 7.
I'm looking at a message in the main window's reading pane, and it seems like sometimes when I hit the main ribbon Reply-All, or type ctrl-shift-R, it pops up a new window with my address removed. Other times it opens a reply on the main window, replacing the reading pane, and fails to remove my address. Actually I think it may be alternating -- first attempt to reply-all works; if I toss that message and then try it again, it fails. Then the next time it works. Etc.
This usually happens when the address the message was sent to isn't the address set up in the account. This should only happen if mail is forwarded from a different account to this one or you have multiple addresses set up to receive mail in the mailbox.
Hi, I've tried all the above steps but when I click reply to all, the address I don't want is still shown in the To:, as if the macro fails to execute.
Please advise.
Did you restart outlook? The macro runs when outlook restarts. If you want to see if its running, add msgbox "Running" as the first line.
`i am trying to fuse both the codes as directed by you, but the 3rd and 4th line shows an error. also plz correct if there is something wrong. 'Remove an Address from Reply All Option Explicit Private WithEvents oExpl As Explorer Private WithEvents oItem As MailItem Private bDiscardEvents As Boolean '//slipstick.me/44b0w Private Sub Application_Startup() Set oExpl = Application.ActiveExplorer bDiscardEvents = False End Sub Private Sub oExpl_SelectionChange() On Error Resume Next Set oItem = oExpl.Selection.Item(1) End Sub ' Reply Private Sub oItem_ReplyAll(ByVal Response As Object, Cancel As Boolean) Cancel = True bDiscardEvents = True Dim oReply As MailItem Set oReply = oItem.ReplyAll Dim recips As Outlook.Recipients Dim i As Long Set recips = oReply.Recipients For i = recips.Count To 1 Step -1 If LCase(recips.Item(i).Address) = "veronica.irvin@xxxxxx.com" Then recips.Remove i End If Next oReply.Display bDiscardEvents = False Set oItem = Nothing End Sub 'Working with All Items in a Folder or Selected Items Option Explicit Public Sub DoSomethingFolder() Dim Ns As Outlook.NameSpace Dim objOL As Outlook.Application Dim objItems As Outlook.Items Dim objFolder As Outlook.MAPIFolder Dim obj As Object Set Ns = Application.GetNamespace("MAPI") Set objOL = Outlook.Application Set objFolder = Ns.GetDefaultFolder(olFolderCalendar) Set objFolder = Ns.GetDefaultFolder(olFolderCalendar).Folders("Subfolder") Set objItems = objFolder.Items For Each obj… Read more »
After you set it to use the correct folder, you'd put this in the loop - Dim oReply As MailItem
Set oReply = oItem.ReplyAll
Dim recips As Outlook.Recipients
Dim i As Long
Set recips = oReply.Recipients
For i = recips.Count To 1 Step -1
If LCase(recips.Item(i).Address) = "veronica.irvin@xxxxxx.com" Then
recips.Remove i
End If
Next
oReply.Display
these two lines are showing as error. please provide me a solution to this
Did you put that macro in the ThisOutlookSession module? if not, you will get errors on those lines.
With the changes i made, including using HTMLBody (and fixing the & signs that wordpress messes up), This screenshot shows the changes - i removed a line of text above "today's Tip" but left a period and added the text at the top.
can this be modified to all the mail items in current sub folder? like reply and send email with attachment with 30 seconds interval, till the last email and end
Yes. If you are running it manually, the macros at https://www.slipstick.com/developer/code-samples/working-items-folder-selected-items/ show howe to do it. You'll need to loop to add the delay - one way to do this:
delayTime = now + .5/1440
do until now > delaytime
'do the send
delayTime = now + .5/1440
loop
i tried to just join the codes and run but it didnt work. here is how i did it. 'Remove an Address from Reply All Option Explicit Private WithEvents oExpl As Explorer Private WithEvents oItem As MailItem Private bDiscardEvents As Boolean '//slipstick.me/44b0w Private Sub Application_Startup() Set oExpl = Application.ActiveExplorer bDiscardEvents = False End Sub Private Sub oExpl_SelectionChange() On Error Resume Next Set oItem = oExpl.Selection.Item(1) End Sub ' Reply Private Sub oItem_ReplyAll(ByVal Response As Object, Cancel As Boolean) Cancel = True bDiscardEvents = True Dim oReply As MailItem Set oReply = oItem.ReplyAll Dim recips As Outlook.Recipients Dim i As Long Set recips = oReply.Recipients For i = recips.Count To 1 Step -1 If LCase(recips.Item(i).Address) = "veronica.irvin@xxxxxx.com" Then recips.Remove i End If Next oReply.Display bDiscardEvents = False Set oItem = Nothing End Sub 'Working with All Items in a Folder or Selected Items Option Explicit Public Sub DoSomethingFolder() Dim Ns As Outlook.NameSpace Dim objOL As Outlook.Application Dim objItems As Outlook.Items Dim objFolder As Outlook.MAPIFolder Dim obj As Object Set Ns = Application.GetNamespace("MAPI") Set objOL = Outlook.Application Set objFolder = Ns.GetDefaultFolder(olFolderCalendar) Set objFolder = Ns.GetDefaultFolder(olFolderCalendar).Folders("Subfolder") Set objItems = objFolder.Items For Each obj In objItems For i = 1 to objitems.count step -1… Read more »
The 'do something' code is running on a subfolder of the calendar... is that where you wanted to run it? The exampl just shows how to use it - you'll need to set it to use the correct folder.
i tried to work it out on my own but couldnt, no i didnt want this to run on calendar, would you mind taking a minute for me to fuse both the codes. i wanted to remove my email address while i hit reply all and add a delay of 5 secs before sending, to all mail items in current folder.
This works here to reply to all messages in a folder and remove a specific address from the messages
Public Sub DoSomethingFolder()
Dim objOL As Outlook.Application
Dim objItems As Outlook.Items
Dim objFolder As Outlook.MAPIFolder
Dim obj As Object
Set objOL = Outlook.Application
Set objFolder = objOL.ActiveExplorer.CurrentFolder
Set objItems = objFolder.Items
For Each obj In objItems
delaytime = Now + 0.5 / 1440
Do Until Now > delaytime
DoEvents
Loop
Dim oReply As MailItem
Set oReply = obj.ReplyAll
Dim recips As Outlook.Recipients
Dim i As Long
Set recips = oReply.Recipients
For i = recips.Count To 1 Step -1
If LCase(recips.Item(i).Address) = "veronica.irvin@xxxxxx.com" Then
recips.Remove i
End If
Next
oReply.Display
Next
Set obj = Nothing
Set objItems = Nothing
Set objFolder = Nothing
Set objOL = Nothing
End Sub
Hi Diane, Thank you so much for replying my post, i am clueless as to why it did not work, i am using outlook 2010, macro security is set to low and restarted many times. when i hit run the outlook freezes. not sure what is wrong, no error notifications too.
i have created a new folder and moved 5 mail items which require reply all and send with 5secs or 30 secs delay after every email.
can you please rework on the code
do you get error messages? I don't see error handling, so it wouldn't be skipping out without throwing errors. You can add msgbox "Running" before each line that begins with For. If the message box doesn't come up, then the macro is not running. Stepping through it (F8 or on the Debug menu and toolbar) can help you see where it is skipping too.
Hi Diane, i did add "Running" before each line that begins with For, it seems there is a compile error with sub or function not defined. and points to 'Public Sub DoSomethingFolder()'
there is nothing in it that calls a sub or function - unless you have option explicit - then you'll get a 'variable not defined' error for Delaytime - adding Dim Delaytime with the other dim's will take care of that. The macro i posted in this comment works here - i really have no idea why it isn't working for you or why you're getting that error.
Hi Diane,
My outlook addin was not allowing to run this code, Got it removed. now it works like charm.
thank you so much.
Not sure if this can be added to this existing code, basically i route the incoming website requests to appropriate department, i normally hit reply all and write
"Hi,
Your request is received and passed on to -- dept, will be addressed asap
Regards"
in this process i have to remove my own email address as recipient and email address comes in the body and hit send.
can it be added to the existing one and run automatically?
it can be added - the macro, as written with the application start up macro is automatic - if you use a rule it is automatic too. You just need to change .display to .send once you are sure it is working correctly.
There are a couple of different ways to add the text -
simplest is
strText = "Hi," & vbCrLf & vbCrLf & _
"Your request is received and passed on, will be addressed asap. " & _
vbCrLf & vbCrLf & "Regards" & vbCrLf & vbCrLf
oReply.body = strText & oreply.body
oreply.display ' or oreply.send
sorry i couldn't mention in my previous post that i need to remove email address in body too, when i hit reply all, please help me with that too. thank you.
is it always the same address? There are different ways to do this, depending on where the address is.
it is always the same address the line appears like this [mailto:veonica.irvin@solution-xxxx.com] and the whole text has to be deleted
Replace function should work then -
item.body = Replace(item.body, "[mailto:veonica.irvin@solution-xxxx.com]", "")
Hi Diane, i joined those two lines and unable to get the result -i.e. remove the address in body and add the message. just pasting the way i did it. not sure what is wrong. hopefully this will help
These are in the wrong order - with the body code inside the if statement that removes the address, it's only applied if the address is removed. (and the message object needs to match the object name you are using in your code):
For i = recips.Count To 1 Step -1
If LCase(recips.Item(i).Address) = "veronica.irvin@solutions-xxxx.com" Then
recips.Remove i
End If
Next
oReply.Body = Replace(oReply.Body, "[mailto:veronica.irvin@solutions-xxxx.com] ", "")
strText = "Hi," & vbCrLf & vbCrLf & _
"Your request is received and passed on, will be addressed asap. " & _
vbCrLf & vbCrLf & "Regards" & vbCrLf & vbCrLf
oReply.Body = strText & oReply.Body
oReply.Display
Next
Thank you so much, its been of great help to me. it is working good.
one last question i have is, can i add another email address (megan.frost@solutions-xxxx.com) as well to this line of code
'oReply.Body = Replace(oReply.Body, "[mailto:veronica.irvin@solutions-xxxx.com] ", "")'
You can - just repeat the line
oReply.Body = Replace(oReply.Body, "[mailto:veronica.irvin@solutions-xxxx.com] ", "")
oReply.Body = Replace(oReply.Body, "[megan.frost@solutions-xxxx.com] ", "")'
Hi Diane, i did join the lines in between , but it didnt work, can you please look into this and reply with a correct one. > i have to remove my email address in the body of email i.e. item.body = Replace(item.body, "[mailto:veronica.irvin@solution-xxxx.com]", "") >and add a reply i.e strText = "Hi," & vbCrLf & vbCrLf & _ "Your request is received and passed on, will be addressed asap. " & _ vbCrLf & vbCrLf & "Regards" & vbCrLf & vbCrLf oReply.body = strText & oreply.body below is the code Public Sub DoSomethingFolder() Dim objOL As Outlook.Application Dim objItems As Outlook.Items Dim objFolder As Outlook.MAPIFolder Dim obj As Object Set objOL = Outlook.Application Set objFolder = objOL.ActiveExplorer.CurrentFolder Set objItems = objFolder.Items For Each obj In objItems delaytime = Now + 0.5 / 10 Do Until Now > delaytime DoEvents Loop Dim oReply As MailItem Set oReply = obj.ReplyAll Dim recips As Outlook.Recipients Dim i As Long Set recips = oReply.Recipients For i = recips.Count To 1 Step -1 If LCase(recips.Item(i).Address) = "veronica.irvin@solutions-xxxx.com" Then recips.Remove i Item.Body = Replace(Item.Body, "[mailto:veronica.irvin@solutions-xxxx.com] ", "") strText = "Hi," & vbCrLf & vbCrLf & _ "Your request is received and passed on, will be… Read more »
What happens when you tried it?
Do you want the body changed only if the address is removed? if not, you need the body code after the End If, not before. You may need to use oReply.HTMLBody in each instance if you need to maintain HTML formatting. Also, you need to use the correct object - Item.Body needs to be changed to oreply.body (or oReply.HTMLBody).
BTW, the delaytime is 12 minutes... did you want it that long? The first number in the fraction is the number of minutes to delay and the other is the number of minutes in a day (1440).
this is not working in my pasrt
Any error messages? Is macro security set to low? Did you restart Outlook?
no error meesage. yep macro security is set to low and yes i did restart
I would like to combine the above script with the one that changes the email account for sending an email. I would like to happen both at the same time with one script since I have already changed the appropriate button to run the script below:
-(Public Sub New_Reply()
-Dim oAccount As Outlook.Account
-Dim oMail As Outlook.MailItem
-For Each oAccount In Application.Session.Accounts
-If oAccount = "the_email_account_name" Then
- Set oMail = Application.ActiveExplorer.Selection(1).Reply
- oMail.SendUsingAccount = oAccount
- oMail.Display
-End If
-Next
-End Sub)
Thanks in advance
I keep coming back to this and can't get it to work - putting them together is easy, but getting outlook to actually change the From account is difficult on replies.