How to Show the Sender’s Company in the Email List with Outlook VBA

Many people want to display the sender’s company in the email list. But there is no such a ready-made column in Outlook. If you hope to achieve it, you can use the method introduced in this article, which uses Outlook VBA.

By default, Outlook has no native support to connect the email list with contacts. Therefore, you cannot achieve the contacts corresponding to the email senders in the mail list. The only way to check the sender’s company is putting your cursor over the sender’s email address. Then you can see a ScreenTip which will display the sender’s company. However, if you want to view several senders’ companies, the above tip will be quite inconvenient. You must hope that Outlook can directly show the senders’ companies in the email list. Thereby, you need to resort to VBA. Here are the elaborate steps and VBA codes.Show the Sender’s Company in the Email List with Outlook VBA

Show the Sender’s Company in the Email List

  1. For a start, launch your Outlook application.
  2. Then press “Alt + F11” key buttons to access VBA editor.
  3. Subsequently, copy the following VBA codes into a new module.
Private Sub DisplaySenderCompanyforExistingEmails()
    Dim objItems As Outlook.Items
    Dim objItem As Object
    Dim objMail As Outlook.MailItem
    Dim strSenderEmailAddress As String
    Dim objContacts As Outlook.Items
    Dim objSenderContact As Outlook.ContactItem
    Dim strFilter As String
    Dim i As Long
    Dim objProperty As Outlook.UserProperty
    Dim strPropertyName As String
 
    Set objItems = Application.Session.GetDefaultFolder(olFolderInbox).Items
    Set objContacts = Application.Session.GetDefaultFolder(olFolderContacts).Items
 
    On Error Resume Next
 
    For Each objItem In objItems
        If objItem.Class = olMail Then
           Set objMail = objItem
           strSenderEmailAddress = objMail.SenderEmailAddress
        End If
 
        'Find out the contact item corresponding to the email sender
        For i = 1 To 3
            strFilter = "[Email" & i & "Address] = " & strSenderEmailAddress
            Set objSenderContact = objContacts.Find(strFilter)
            If Not objSenderContact Is Nothing Then
               'Create a new field for the sender company
               strPropertyName = "Sender Company"
               Set objProperty = objMail.UserProperties.Add(strPropertyName, olText, True)
               objProperty.Value = objSenderContact.CompanyName
               objMail.Save
            End If
        Next
    Next
End Sub

VBA Codes - Display the Senders' Companies for the Exsiting Emails

  1. After that, click the “Run” icon in the toolbar to run the new macro.Run the New Macro
  2. Next you can exit the VBA editor.
  3. And then you need to add the “Sender Company” column.Add the Sender Company Column
  • Firstly, switch to “View” tab.
  • Then click “View Settings”.
  • In the popup dialog box, hit “Columns”.
  • Then in the subsequent dialog, select “User-defined columns in Inbox”.
  • After that, pitch on the “Sender Company”.
  • And next hit “Add”.
  • Ultimately, click a series of “OK” to close all the dialog boxes.

Note: You‘re also allowed to change the column orders at will.

  1. Later press “Alt + F11” key shortcuts to open VBA editor again.
  2. Afterwards, copy the following codes into the “ThisOutlookSession” project.
Public WithEvents objItems As Outlook.Items

Private Sub Application_Startup()
    Set objItems = Application.Session.GetDefaultFolder(olFolderInbox).Items
End Sub

Private Sub objItems_ItemAdd(ByVal Item As Object)
    Dim objMail As Outlook.MailItem
    Dim strSenderEmailAddress As String
    Dim objContacts As Outlook.Items
    Dim objSenderContact As Outlook.ContactItem
    Dim strFilter As String
    Dim i As Long
    Dim objProperty As Outlook.UserProperty
    Dim strPropertyName As String
 
    If Item.Class = olMail Then
       Set objMail = Item
       strSenderEmailAddress = objMail.SenderEmailAddress
    End If
 
    Set objContacts = Application.Session.GetDefaultFolder(olFolderContacts).Items
 
    'Find out the contact item corresponding to the email sender
    For i = 1 To 3
        strFilter = "[Email" & i & "Address] = " & strSenderEmailAddress
        Set objSenderContact = objContacts.Find(strFilter)
        If Not objSenderContact Is Nothing Then
           'Create a new field for the sender company
           strPropertyName = "SenderCompany"
           Set objProperty = objMail.UserProperties.Add(strPropertyName, olText, True)
           objProperty.Value = objSenderContact.CompanyName
           objMail.Save
        End If
    Next
End Sub
  1. Finally you can restart Outlook to activate the “ThisOutlookSession” project.

From now on, Outlook will automatically check the incoming email senders with the contacts in the default contacts folder. Once find the corresponding contact, it will extract its company and display in the “Sender Company” column.

Display the Sender Company in the Email List

Avoid Damaging Your Outlook Data

In most cases, PST corruption comes from human mistakes, such as bad habits of frequently closing Outlook improperly and opening suspicious email links and so on. Therefore, if you want to keep your Outlook data in good health, you ought to start from correcting your wrong operations in Outlook.

Author Introduction:

Shirley Zhang is a data recovery expert in DataNumen, Inc., which is the world leader in data recovery technologies, including corrupted mdf and outlook repair software products. For more information visit www.datanumen.com

Comments are closed.