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: 2018/02/03 | Accessed: 71.885  | #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. After you´ve sent or received the next email, the new field will be added to the folder. In order to make the new field then 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. (If you also want to add the field to the emails that already exist in the folder, move the emails to another folder and back.)


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_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
ReplyAll ReplyAll
ReplyAll alerts you before unintentionally replying all, or if you are a confidential BCC recipient of the e-mail.
email  Send a message