A user wanted to know how to sort email messages by domain. Although you can filter by domain simply by typing the domain name in the address field, you can't sort as easily.
You can create a custom Formula field using this formula: right([SearchFromEmail],len([SearchFromEmail])-InStr(1,[SearchFromEmail],"@"))
Unfortunately, you can't sort by formula fields. However, custom Text fields are sortable and you can use a macro to add the domain to the custom field.
To use the first macro, select the messages then run the macro. To add the domain field to messages as they arrive, you'll need to use the run a script rule below.
Macro for selected messages
Public Sub SetDomain() ' From http://slipstick.me/1 Dim currentExplorer As Explorer Dim Selection As Selection Dim obj As Object Dim objProp As Outlook.UserProperty Dim strDomain Set currentExplorer = Application.ActiveExplorer Set Selection = currentExplorer.Selection On Error Resume Next For Each obj In Selection Set objMail = obj strDomain = Right(objMail.SenderEmailAddress, Len(objMail.SenderEmailAddress) - InStr(objMail.SenderEmailAddress, "@")) Set objProp = objMail.UserProperties.Add("Domain", olText, True) objProp.Value = strDomain objMail.Save Err.Clear Next Set currentExplorer = Nothing Set obj = Nothing Set Selection = Nothing End Sub
If you use Exchange server, the field will contain the Exchange x.500 address for mail from Internal senders. The easiest fix is to use an if statement to look for an @ sign. No @ sign means it's internal email. You can then enter your domain for these senders or use their alias.
For Each obj In Selection Set objMail = obj Set objProp = objMail.UserProperties.Add("Domain", olText, True) If InStr(1, objMail.SenderEmailAddress, "@") > 0 Then strDomain = Right(objMail.SenderEmailAddress, Len(objMail.SenderEmailAddress) - InStr(objMail.SenderEmailAddress, "@")) Else ' strDomain = "yourdomain.com" ' use this for the alias - you may need to use /cn in on-prem strDomain = Right(objMail.SenderEmailAddress, Len(objMail.SenderEmailAddress) - InStrRev(objMail.SenderEmailAddress, "-")) End If objProp.Value = strDomain
Create the custom field and add it to your view
To add the custom field to the view follow these steps:
- Close or reduce the size of the reading pane so the From, Subject, Received date and other fields are on one line
- Right click on the row of field names and then choose Field Chooser from the menu
- Click New and type Domain in the Name field
- If User-defined field in [folder] is not visible, select it, then drag the newly created Domain field to the row of field names
Click on the Domain name to sort..
Run a script rule
Use the following macro in a run a script rule. If you need instructions, see Outlook's Rules and Alerts: Run a Script.
Public Sub SetDomainScript(Item As Outlook.MailItem) ' Fromhttp://slipstick.me/1 Dim objProp As Outlook.UserProperty Dim strDomain strDomain = Right(objMail.SenderEmailAddress, Len(objMail.SenderEmailAddress) - InStr(1, objMail.SenderEmailAddress, "@")) Set objProp = Item.UserProperties.Add("Domain", olText, True) objProp.Value = strDomain Item.Save End Sub
Add the Sent To domain
This macro gets the first email address a message is sent to and adds it to the Domain field. You could loop through the entire recipient list and get all addresses or domains, but the list is a simple text list and sorts by the first domain, making it less useful.
This macro works on both incoming messages and messages in your sent folder.
Public Sub SetToDomain() ' Fromhttp://slipstick.me/1 Dim currentExplorer As Explorer Dim Selection As Selection Dim obj As Object Dim objProp As Outlook.UserProperty Dim strDomain Dim recips As Outlook.Recipients Dim recip As Outlook.Recipient Dim pa As Outlook.propertyAccessor Dim Address As String Dim lLen Const PR_SMTP_ADDRESS As String = "http://schemas.microsoft.com/mapi/proptag/0x39FE001E" Set currentExplorer = Application.ActiveExplorer Set Selection = currentExplorer.Selection On Error Resume Next For Each obj In Selection Set objMail = obj ' This gets the first recipient's address Set recips = objMail.Recipients Set recip = recips.Item(1) Set pa = recip.propertyAccessor Address = LCase(pa.GetProperty(PR_SMTP_ADDRESS)) lLen = Len(Address) - InStrRev(Address, "@") strDomain = Right(Address, lLen) Set objProp = objMail.UserProperties.Add("Domain", olText, True) objProp.Value = strDomain objMail.Save Err.Clear Next Set currentExplorer = Nothing Set obj = Nothing Set Selection = Nothing End Sub
Create other fields
You can customize the macro to work with other fields. In this example, I'm adding a text field containing the received date formatted in Month day format. Don't forget to use a unique name for the field!
Tip: if you want to sort by a date field, use "yyyy mm dd" for the date format, use olDateTime instead of oltext.
strDomain = Format(objMail.ReceivedTime, "mm/dd/yyyy")
Set objProp = objMail.UserProperties.Add("MyDate", olDateTime, True)
Public Sub SetDate() ' Fromhttp://slipstick.me/1 Dim currentExplorer As Explorer Dim Selection As Selection Dim obj As Object Dim objProp As Outlook.UserProperty Dim strDomain Dim objMail As MailItem Set currentExplorer = Application.ActiveExplorer Set Selection = currentExplorer.Selection On Error Resume Next For Each obj In Selection Set objMail = obj ' make changes here strDomain = Format(objMail.ReceivedTime, "MMM dd") Set objProp = objMail.UserProperties.Add("MyDate", olText, True) objProp.value = strDomain objMail.Save Err.Clear Next Set currentExplorer = Nothing Set obj = Nothing Set Selection = Nothing End Sub
To use the macros with other Outlook item types, you only need to change the item type in the Dim statements:
Dim objMail As TaskItem
And the field:
strDomain = Format(objMail.CreationTime, "MMM dd yyyy")
And, of course, you might want to change the field name and type:
Set objProp = objMail.UserProperties.Add("ThisField", olDateTime, True)
Yes, it would be less confusing to use a generic object name, like objItem, but as long as the field is supported by the declared object, it will work.
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.
More information as well as screenshots are at How to use the VBA Editor
is there any way to make this macro stay there forever and set a shortcut or button?
So if i click that buttom, it should sort according to domain?
Dear Diane, I added a New Column, named DOMAIN, selected all the messages in my Inbox, around 10000, and ran the macro. First it took ages to populate the Domain field values. Second upon clicking Sort, it simply was not doing it, descending or ascending. Then I noticed, it does some sort of sorting, but could understand it is an extremely slow process. The same process I tried in another mail folder, with 250 messsages, and I was able to sort and group by Domain values. Kindly help me implement the same process for my Inbox, as I really want to clear all the Junk/Useless mails, which are from around 3000 senders, but if I can group them by Domain, it would be a few hundred.
Sorting the messages according to the number of messages based on Domain values, instead of alphabetic sequence, would be the next step, but this can be a secondary goal. Thanks for your kind help.
Yeah, its definitely a slow macro - it needs to touch every message. I don't believe t can be speeded up. Sorry. (Sorry I missed this earlier).
Hey, i share the method to folder sent.
For Each aObj In Application.ActiveExplorer.Selection
Set oMail = aObj
' This gets the first recipient's address
Set recips = oMail.Recipients
sTmp = recips.Item(1).Address
If InStr(1, sTmp, "@") > 0 Then
sDomain = Right(sTmp, Len(sTmp) - InStr(sTmp, "@"))
Else
If InStr(1, sTmp, "/o=") > 0 Then
sDomain = "att.com"
' use this for the alias - you may need to use /cn in on-prem
nPos = InStr(1, sTmp, "=")
nNext = InStr(nPos + 1, sTmp, "/")
nLen = nNext - nPos
sDomain = Mid(sTmp, nPos + 1, nLen - 1)
Else
sDomain = Right(sTmp, Len(sTmp) - InStrRev(sTmp, "-"))
End If
End If
' sDomain = Right(oMail.SenderEmailAddress, Len(oMail.SenderEmailAddress) - InStr(1, oMail.SenderEmailAddress, "@"))
Set oProp = oMail.UserProperties.Add("NewDomain", olText, True)
oProp.Value = sDomain
oMail.Save
Err.Clear
Next
Great tips.
Also see my column formula:
IIf(InStr([SearchFromEmail], "@") = 0, "", Mid([SearchFromEmail], InStr([SearchFromEmail], "@") + 1))
And info here
http://stackoverflow.com/questions/43849213/can-i-add-a-custom-email-domain-column-in-outlook/43889643#43889643
How to remove the field andits contents if the Macro did not work correctly? I run the AddDomain Macro and it worked on the emails coming from outside my company but for the emails that come from inside my company the field added something like this: "/o=company/ou=exchange admin...". I will like to undo what I did until I figure out how to adjust the script. Any ideas?
That is normal. On other pages i have examples using left/right functions that get just the alias from the exchange x500 address or you can use an if statement something like
Set objProp = objMail.UserProperties.Add("Domain", olText, True)
If InStr(1, objMail.SenderEmailAddress, "@") > 0 Then
strDomain = Right(objMail.SenderEmailAddress, Len(objMail.SenderEmailAddress) - InStr(objMail.SenderEmailAddress, "@"))
Else
strDomain = "yourdomain.com"
' to get the exchange alias in office 365 exchange online
' strDomain = Right(objMail.SenderEmailAddress, Len(objMail.SenderEmailAddress) - InStrRev(objMail.SenderEmailAddress, "-"))
' or in on-prem
' strDomain = Right(objMail.SenderEmailAddress, Len(objMail.SenderEmailAddress) - InStrRev(objMail.SenderEmailAddress, "/cn"))
End If
objProp.Value = strDomain
BTW, just changing this line should erase the value from the field -
objProp.Value = "" (it might only work if you do it immediately and won't work if you use the formula method to set the field - you'll need to change the formula or delete the field)
Hello,
I have to use the above script on inbox , and use the proprties:
PropTag=PidTagSenderSmtpAddress_W
NmidInteger=0x5D01
In the script there is an object relaited recipient, I need to relait to sender
Thank
Thanks, Diane, this is very useful. However, for some reason when I run the script rule this line is not able to extract the domain name:
strDomain = Right(objMail.SenderEmailAddress, Len(objMail.SenderEmailAddress) - InStr(1, objMail.SenderEmailAddress, "@"))
It gives nothing. I added on Error resume next and changed objMail with Item but still this line is not working. What could be the issue?
I am again. Here's the code. I'm in my .txt file the number of items per sender. But not write in column D (created previously) What is the solution? PS I am not a developer, I try to learn. ----------- ub CombienMailsDate() Dim objOutlook As Object, objnSpace As Object, objFolder As MAPIFolder Dim Sender As Outlook.AddressEntry Dim mail As String Dim myItems As Outlook.Items Dim dict As Object Dim msg As String Dim aObj As Object Dim oProp As Outlook.UserProperty Set objOutlook = CreateObject("Outlook.Application") Set objnSpace = objOutlook.GetNamespace("MAPI") On Error Resume Next Set objFolder = ActiveExplorer.CurrentFolder If Err.Number 0 Then Err.Clear MsgBox "No such folder." Exit Sub End If Set dict = CreateObject("Scripting.Dictionary") Set myItems = objFolder.Items myItems.SetColumns ("SenderEmailAddress") For Each myItem In myItems mail = myItem.SenderEmailAddress If Not dict.Exists(mail) Then End If dict(mail) = CLng(dict(mail)) + 1 Next myItem On Error Resume Next ' Output counts per sender: msg = "" For Each o In dict.Keys msg = msg & o & ": " & dict(o) & " items" & vbCrLf On Error Resume Next For Each aObj In Application.ActiveExplorer.Selection Set oMail = aObj If o = myItem.SenderEmailAddress Then Set oMail = aObj Set oProp = oMail.UserProperties.Add("D", olNumber, True)… Read more »