I'm frequently asked how to display the recipient's email address in the Sent Items folder. The answer is this macro, which adds a custom field containing the addresses the message was sent to. The custom address field is a text field and you can sort or group by it.
Note that when a message is sent to multiple people, all addresses will be entered in the field as one long string, as seen in this example.
/o=ExchangeLabs/ou=Exchange Administrative Group (FYDIBOHF23SPDLT)/cn=Recipients/cn=43dfb970e3b54f85942d1348b58581e6-drcp;billy@domain.net;
Exchange server addresses are the x.500 address (as seen in the example above), not the SMTP address, however, you can use the Right() function to keep just the alias.
Public Sub GetRecipientAddress()
'http://slipstick.me/9vjgj
Dim currentExplorer As Explorer
Dim Selection As Selection
Dim obj, objMail As Object
Dim objProp As Outlook.UserProperty
Dim strDomain
Dim Recipients As Outlook.Recipients
Dim recip As String
Dim i
Dim prompt As String
Set currentExplorer = Application.ActiveExplorer
Set Selection = currentExplorer.Selection
On Error Resume Next
For Each obj In Selection
Set objMail = obj
strDomain = ""
Set Recipients = objMail.Recipients
For i = Recipients.count To 1 Step -1
recip$ = Recipients.item(i).Address
' To use only the alias from the x.500 address
' Exchange online
'If InStr(1, LCase(recip), "/ou=") Then recip = Right(recip, Len(recip) - InStr(1, LCase(recip), "-"))
' on prem
'If InStr(1, LCase(recip), "/ou=") Then recip = Right(recip, Len(recip) - InStr(1, LCase(recip), "recipients") - 13)
' Use semicolon separator if there is more than 1 address
If i = 1 Then
strDomain = strDomain & recip
Else
strDomain = strDomain & recip & "; "
End If
Next i
Debug.Print strDomain
' Msgbox strDomain
Set objProp = objMail.UserProperties.Add("Recipient Email", olText, True)
objProp.Value = strDomain
objMail.Save
Err.Clear
Next
Set currentExplorer = Nothing
Set obj = Nothing
Set Selection = Nothing
End Sub
To write the address list to a new message for easy reading, replace the Set objProp = to objMail.Save lines with the following:
Set objMsg = Application.CreateItem(olMailItem) With objMsg .Body = strDomain .Display End With
Add the field automatically
To add the recipient address field automatically, you need to use an ItemAdd macro. These macros need to be in ThisOutlookSession. To test, click in the Application_Startup macro and click Run then send a message.
Dim WithEvents olSent As Items
Private Sub Application_Startup()
Dim NS As Outlook.NameSpace
Set NS = Application.GetNamespace("MAPI")
Set olSent = NS.GetDefaultFolder(olFolderSentMail).Items
Set NS = Nothing
End Sub
Private Sub olSent_ItemAdd(ByVal Item As Object)
' Fromhttp://slipstick.me/1
Dim objProp As Outlook.UserProperty
Dim strDomain As String
Dim Recipients As Outlook.Recipients
Dim recip As String 'Outlook.Recipient
Dim i
strDomain = ""
Set Recipients = Item.Recipients
For i = Recipients.count To 1 Step -1
recip$ = Recipients.Item(i).Address
' Exchange online
'If InStr(1, LCase(recip), "/ou=") Then recip = Right(recip, Len(recip) - InStr(1, LCase(recip), "-"))
' on prem
'If InStr(1, LCase(recip), "/ou=") Then recip = Right(recip, Len(recip) - InStr(1, LCase(recip), "recipients") - 13)
If i = 1 Then
strDomain = strDomain & recip
Else
strDomain = strDomain & recip & "; "
End If
Next i
Set objProp = Item.UserProperties.Add("Recipient Email", olText, True)
objProp.Value = strDomain
Item.Save
Err.Clear
Set objProp = Nothing
Set Recipients = Nothing
End SubHow to use this 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 put the code in a module:
- Right click on Project1 and choose Insert > Module
- Copy and paste the macro into the new module.
More information as well as screenshots are at How to use the VBA Editor
Evan says
Hi Diane,
First off thanks so much for all the years you have contributing and maintaining this forum (sincere and immense appreciation for this).
Reaching out to see if you could provide VBA code that does the following:
Creates an outlook field to list all email addresses (the sender's and all the recipients' (to, cc, bcc)) included in an outlook item?
Ideally this would not include any .500 addresses and show only the external facing SMTP addresses. Would look for this field to be a keyword field. This would allow for a grouping of all messages involving any one specific email address (all messages sent to or from any one address).
The approach I had in mind was to use the following:
PR_CREATOR_SMTP_ADDRESS_W (0x5D0A001F) to reference a clean “from address”
And using the Property accessor with the Recipient object to access the PR_SMTP_ADDRESS_W (0x39FE001F) of all the recipients
Would then concatenate the above strings with a semicolon between each SMTP email address.
Also, a second macro that utilizes the exact same code or references the result of the above; however, it includes a text function such that the result is only the domains (“xxx.com”) of all the addresses. Again, being a keyword field would allow to show all messages, calendar invites, etc. sent to or from a domain (i.e. grouping all outlook items involving any one domain)
I have no idea if its possible or if it would make a difference, but an alternative approach I was thinking that may speed up the macro would be to use a CFG file to add the Sender and Recipient SMTP addresses. Then just use a macro to reference those fields to create the concatenated email keyword field. Would extend this approach by referencing those fields but incorporating a textafter() or equivalent functionality to strip the text to yield only the domains keyword field.
I have been banging my head against the wall trying to cook this up for weeks, but my VBA skills are extremely weak.
Thanks so much in advance. Any help would be much appreciated.
Diane Poremsky says
Tweaking this macro to do that is possible... and I have one somewhere that does the domain.
David says
Hi Diane,
I had been searching all over for a solution to this and finally stumbled across your solution. I'm so glad I found your post.
One area of trouble I'm having is that the code in "ThisOutlookSession." Sometimes when I send email, the "Recipient Email" property gets populated and other times it doesn't.
When it doesn't, what's strange is that after emails are sent, the "Recipient Email" property gets populated but then a moment later it deletes itself. I can see it happen live if I add the "Recipient Email" column to my view. Any thoughts on how to correct this?
I've ensured that macros are running so that's not the issue. I added a "Stop" statement to the code so I could debug it, and even after going step by step, the property populates at the line "Item.Save" and then a moment later disappears. And that's before moving onto the next line of "Err.Clear."
David
David says
Hi Diane,
I had been searching all over for a solution to this and finally stumbled across your solution. I'm so glad I found your post.
One area of trouble I'm having is that the code in "ThisOutlookSession." Sometimes when I send email, the "Recipient Email" property gets populated and other times it doesn't.
When it doesn't, what's strange is that after emails are sent, the "Recipient Email" property gets populated but then a moment later it deletes itself. I can see it happen live if I add the "Recipient Email" column to my view. Any thoughts on how to correct this?
I've ensured that macros are running so that's not the issue. I added a "Stop" statement to the code so I could debug it, and even after going step by step, the property populates at the line "Item.Save" and then a moment later disappears. And that's before moving onto the next line of "Err.Clear."
David
Paul says
Hi Diane
Apologies for my lack of understanding- I originally downloaded this from howtooutlook.com and noticed your address in the script. I have it running, but it shows the senders email address- which isn't any use to me in sent items. I'm trying to see the actual email address of where it was sent to and so want to show the column in the sent items- is this possible with a tweak? I think I may have missed something as this page is headed as though it should do as I need it to. Thanks in advance
Ben says
I tried following the instructions but it still shows the long exchange data in the recipient address field.
Diane Poremsky says
Did you remove the ' from this line:
' If InStr(1, LCase(recip), "/ou=") Then recip = Right(recip, Len(recip) - InStr(1, LCase(recip), "recipients") - 13)
it's still leave an ugly alias: 43dfb970e3b54f85942d1348b58581e6-drcp but drops the rest of the x500 junk. By improving the formula, Right(recip, Len(recip) - InStr(1, LCase(recip), "recipients") - 13), you could get it down to just the alias.
Diane Poremsky says
Replacing the line that removes most of the x500 with this works her (none of my aliases have - in them, so there is no risk of error)
If InStr(1, LCase(recip), "/ou=") Then
recip = Right(recip, Len(recip) - InStr(1, LCase(recip), "recipients") - 13)
recip = Right(recip, Len(recip) - InStr(1, LCase(recip), "-"))
End If
chandrasekhar says
HI, I have mail with table and some html elements such as hyperlinks etc. I would like to open the mail and when i run the macro, it has to create an appointment with the same html format (tables as it is and hyperlink text message). I tried it in 2013 and 2010 versions. It is converting into plain text. Any advise.
Also, i have to add an additional text in the appointment along the with the message from outlook. Let' say: "Hi" & mail body with html formats (Tables, hyperlinks).
williamlambton says
I have put an item at the bottom here:
https://forums.slipstick.com/threads/86266-customised-to-cc-bcc-and-have-replies-sent-to-columns-in-message-lists/.
That's my own thread dated 10th July 2011 (eleven), though I first started hunting for this facility in 2010 (I think). Very good to see the question at last addressed!
Kristian says
Works like a charm.
Thank you very much Diane!
Kristian says
Please disregard my previous reply. It sort of works now, but only when I select multiple emails and it doesn't behave as expected.
It takes the domain from the preceding email in the selection.
Example:
Selection 1 - Email: lorem@ipsum.com Domain:
Selection 2 - Email: ipsum@lorem.com Domain: ipsum.com
Selection 3 - Email something@else.com Domain: lorem.com
-Kristian
Diane Poremsky says
You're setting the strdomain value before getting the recipient - swap the lines and it will work
Set Recipients = objMail.Recipients
recip$ = Recipients.Item(1).Address
strDomain = Right(recip, Len(recip) - InStr(1, recip, "@"))
Kristian says
Thanks for your quick reply Diane, however I'm unable to get it to function.
The macro executes without any error, but no data is populated in the recipient email field. I'm working in a exported PST opened in Outlook 2010 if that makes any difference.
I don't know if there might be a conflict, but I'm trying to use this in conjunction with your 'Sort message by sender domain', which works perfectly.
This is all very new to me, so I greatly appriciate your help.
My modified code:
Public Sub GetRecipientAddress()
' http://slipstick.me/9vjgj
Dim currentExplorer As Explorer
Dim Selection As Selection
Dim obj, objMail As Object
Dim objProp As Outlook.UserProperty
Dim strDomain
Dim Recipients As Outlook.Recipients
Dim recip As String
Dim prompt As String
Set currentExplorer = Application.ActiveExplorer
Set Selection = currentExplorer.Selection
On Error Resume Next
For Each obj In Selection
Set objMail = obj
strDomain = Right(recip, Len(recip) - InStr(1, recip, "@"))
Set Recipients = objMail.Recipients
recip$ = Recipients.Item(1).Address
Debug.Print strDomain
Set objProp = objMail.UserProperties.Add("Recipient Email", olText, True)
objProp.Value = strDomain
objMail.Save
Err.Clear
Next
Set currentExplorer = Nothing
Set obj = Nothing
Set Selection = Nothing
End Sub
Thanks, Kristian
Kristian says
Is there a quick way to modify this to show only the domain of the first recipient?
Diane Poremsky says
Use
recip$ = Recipients.Item(1).Address
strDomain = recip
Delete the For i = 1 to... line and the If i =... Next i block.
Diane Poremsky says
BTW, to get just the domain, you need to use Right and Len functions-
strDomain = Right(recip, Len(recip) - InStr(1, recip, "@"))
Scott says
When I try to paste into ThisOutlookSession, it automatically moves me to Module1. When I paste into there and go to Application_Startup and hit the run/play button, I get:
Complie Error: Only valid in object module
Please advise.
Thanks.
Scott
Diane Poremsky says
Something is not right. When you paste in a module, it should stay in that module. The compile error means it needs to be in ThisOutlookSession.
Scott says
Now I am trying to get the automatic macro to work. I copied the code into a class module in VBA and then went to ThisOutlookSession, and in the Application_Setup section, I hit the play button to run the Macro. It does not do anything. I am pretty sure I deleted the other macros as nothing shows up under Macros in Outlook except the auto one now. Please advise. It would be great to have this automatic.
Diane Poremsky says
Don't put it in a class module - put it in either thisoutlooksession or a regular module.
Scott says
I figured it out. The Next i line has to be changed, not the Next line. Code here works.
Public Sub GetRecipientOnlyAddress()
' http://slipstick.me/9vjgj
Dim currentExplorer As Explorer
Dim Selection As Selection
Dim obj, objMail As Object
Dim objProp As Outlook.UserProperty
Dim strDomain
Dim Recipients As Outlook.Recipients
Dim recip As String
Dim i
Dim prompt As String
Set currentExplorer = Application.ActiveExplorer
Set Selection = currentExplorer.Selection
On Error Resume Next
For Each obj In Selection
Set objMail = obj
strDomain = ""
Set Recipients = objMail.Recipients
For i = Recipients.Count To 1 Step -1
If Recipients.Item(i).Type = olTo Then
recip$ = Recipients.Item(i).Address
Else
GoTo Nexti
End If
' To use only the alias from the x.500 address
' If InStr(1, LCase(recip), "/ou=") Then recip = Right(recip, Len(recip) - InStr(1, LCase(recip), "recipients") - 13)
' Use semicolon separator if there is more than 1 address
If i = 1 Then
strDomain = strDomain & recip
Else
strDomain = strDomain & recip & "; "
End If
Nexti:
Next i
Debug.Print strDomain
Set objProp = objMail.UserProperties.Add("Recipient Email", olText, True)
objProp.Value = strDomain
objMail.Save
Err.Clear
Next
Set currentExplorer = Nothing
Set obj = Nothing
Set Selection = Nothing
End Sub
Scott says
Can you please post what the exact text should be for both the manual and automatic? I cannot figure out this part:
and change the line with Next to
Nexti:
Next i
Everything I try reports back errors.
Thanks.
Scott
Scott says
I am sorry, I am just not that good with this. I tried to make the modifications but it did not work. Can you please assist. I would like to go back and manually change all the old emails and then do the automatic. Thanks again.
Diane Poremsky says
I assume you got this squared away? :)
Scott says
I also noticed another problem. The macro puts anyone on the CC line into the Recipient Email field. Is there anyone to exclude this and only include only the email addresses in the To field? Thanks.
Diane Poremsky says
If you only want the To field use For i = Recipients.Count To 1 Step -1
If Recipients.Item(i).Type = olTo Then
recip$ = Recipients.Item(i).Address
Else
GoTo Nexti
end if
and change the line with Next to
Nexti:
Next i
That tells the macro to jump to the line after Nexti
Scott says
Sorry I cannot figure out how to delete the Macro. I am on Outlook 2010. Can you please advise?
Diane Poremsky says
Open the VBA editor, select the macro and press Delete :)
Scott says
Thank you. I removed the old macro and added the new one, now the ; is not listed. However I am unclear how to add the automatic macro. Currently I have the following tree in Visual Basic:
Project 1
- Microsoft Outlook Objects
- ThisOutlookSession
- Modules
- Module1
I copied the GetRecipientAddress Macro in Module1 and the same text also appears in ThisOutlookSession. Do I paste in the automatic macro text below this under ThisOutlookSession? I do not see an option for adding an ItemAdd macro.
Lastly, will this be saved so that it is automatically running each time I start up my computer and open Outlook?
Thanks again.
Diane Poremsky says
I would run the manual macro on the existing items then remove it, to reduce confusion. Paste the macro under the 'add the field automatically' heading to ThisOutlookSession. The application start macro kicks in when outlook starts - you can kick start it without needing to restart outlook by clicking in it and hitting Run. As long as you click Save, either now or when you close outlook and say yes to the dialog asking if you want to save the macro, it will run every time.
Scott says
This is great, thanks so much. It looks like I have to run the macro manually for all emails that come in. Is there a way to have this be automatic for all incoming emails? Also is there a way to remove the ; that is after the email? I understand if there is more than one recipient but I am getting a ; after all of them. Thanks again.
Diane Poremsky says
it needs a little tweaking to convert to a run a script rule but is possible. The semicolon is added in this line: strDomain = recip & ";" & strDomain and yes, you can remove it but you'll need a separator for when there are multiple addresses. You can change it to a different character(s). To use it only when there are multiple addresses, you'll need to use an If statement and get the recipients count.
Diane Poremsky says
I added an if statement so that when its down to the last (or only) recipient, an ending semicolon isn't added.
Diane Poremsky says
I added an itemadd version of the macro (i forgot, you can't use a run a script rule with sent items).