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 ' 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 '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 Sub
How 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
More Information
Sort messages by Sender domain
How to display the sender's email address in Outlook
Read MAPI properties not exposed in Outlook's Object Model
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
I tried following the instructions but it still shows the long exchange data in the recipient address field.
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.
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
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).
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!
Works like a charm.
Thank you very much Diane!
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
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, "@"))
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
Is there a quick way to modify this to show only the domain of the first recipient?
Use
recip$ = Recipients.Item(1).Address
strDomain = recip
Delete the For i = 1 to... line and the If i =... Next i block.
BTW, to get just the domain, you need to use Right and Len functions-
strDomain = Right(recip, Len(recip) - InStr(1, recip, "@"))