VBOffice

Display the Email Address of the Recipient

Often the display name of an email recipient changes, making it impossible to sort these emails. This macro creates a new field with the pure email address.

Last modified: 2016/12/17 | Accessed: 16.599  | #101
◀ Previous sample Next sample ▶
Reporter Reporter
VBOffice Reporter is an easy to use tool for data analysis and reporting in Outlook. A single click, for instance, allows you to see the number of hours planned for meetings the next month.

In the folder view Outlook doesn't show e-mail addresses but display names. These display names are often different even for the same recipient, so sorting or grouping by this field is useless.

This macro creates a new field for both the Sent Items folder, and the Inbox, which will hold the pure e-mail addresses. For the Sent Items folder the field is created as a Keyword field so you can group by it like Categories. The name of this new field is 'RecipientAddresses', or 'SenderAddress' for the Inbox, respectively.

Paste the code to the ThisOutlookSession module, and restart Outlook. In order to make the new field visible in the folder, click View Settings/Columns, switch from 'Frequently-used fields' to 'User-defined fields', and drag the field name to the right.


tip  How to add macros to Outlook
Private WithEvents m_Inbox As Outlook.Items
Private WithEvents m_SentItems As Outlook.Items

Private Sub Application_Startup()
  Dim Session As Outlook.NameSpace
  Set Session = Application.Session
  
  Set m_Inbox = Session.GetDefaultFolder(olFolderInbox).Items
  Set m_Inbox = Application.ActiveExplorer.CurrentFolder.Items
  Set m_SentItems = Session.GetDefaultFolder(olFolderSentMail).Items
End Sub

Private Sub m_Inbox_ItemAdd(ByVal Item As Object)
  AddAddresses Item, False
End Sub

Private Sub m_SentItems_ItemAdd(ByVal Item As Object)
  AddAddresses Item, True
End Sub

Private Sub AddAddresses(Item As Object, ByVal IsSentMail As Boolean)
  Dim Recipients As Outlook.Recipients
  Dim R As Outlook.Recipient
  Dim UserProps As Outlook.UserProperties
  Dim Prop As Outlook.UserProperty
  Dim Adr As String
  Dim FieldName As String
  
  If IsSentMail Then
    FieldName = "RecipientAddresses"
    Set Recipients = Item.Recipients
    For Each R In Recipients
      Adr = Adr & R.Address & "; "
    Next
    If Len(Adr) Then
      Adr = Left$(Adr, Len(Adr) - 2)
    End If
  Else
    FieldName = "SenderAddress"
    Adr = Item.SenderEmailAddress
  End If
  
  If Len(Adr) Then
    Set UserProps = Item.UserProperties
    Set Prop = UserProps.Find(FieldName, True)
    If Prop Is Nothing Then
      If IsSentMail Then
        Set Prop = UserProps.Add(FieldName, olKeywords, True)
      Else
        Set Prop = UserProps.Add(FieldName, olText, True)
      End If
    End If
    Prop.Value = Adr
    Item.Save
  End If
End Sub
SAM SAM
Determine the "identity" of your emails. Set with SAM the sender and the folder folder for sent items with the help of rules.
email  Send a message