Adding the Sender’s Email Address to an Outlook View


Twitter user Samuli Hiltunen (@smuli) asked me if there is a way to have the sender’s email address appear in an Outlook view. The quick answer is no. Although the sender’s email address is included in an email (that’s obvious since you couldn’t reply without it) Microsoft didn’t make it available in the list of fields you can include in a view. Making the field available to a view requires some scripting (i.e. a macro). The macro is quite simple though. For each message that arrives it creates a user-defined property and inserts the sender’s email address in it. User-defined properties are available to views, so once the macro is in place all Samuli need do is add the user-defined field to the view.

Instructions

Follow these instructions to add the code to Outlook.

  1. Start Outlook
  2. Click Tools > Macro > Visual Basic Editor
  3. If not already expanded, expand Microsoft Office Outlook Objects
  4. If not already expanded, expand Modules
  5. Select an existing module (e.g. Module1) by double-clicking on it or create a new module by right-clicking Modules and selecting Insert > Module.
  6. Copy the code below and paste it into the right-hand pane of Outlook’s VB Editor window
  7. Click the diskette icon on the toolbar to save the changes
  8. Close the VB Editor
Private Sub AddSenderAddress(Item As Outlook.MailItem)
    Dim olkPrp As Outlook.UserProperty
    On Error Resume Next
    Set olkPrp = Item.UserProperties.Add("SenderAddress", olText, True)
    olkPrp.Value = Item.SenderEmailAddress
    Item.Save
    On Error GoTo 0
    Set olkPrp = Nothing
End Sub

The next step is to create a rule that triggers the macro. Here’s how to do that.

  1. Click Tools > Rules and Alerts.
  2. Click New Rule
  3. Select Check messages when they arrive under Start from a blank rule
  4. Click Next
  5. Leave the condition blank and click Next
  6. Click Yes in answer to the warning that the rule will run for every message
  7. For an action select run a script by checking the box next to that option
  8. Click the blue underlined a script in the lower pane of the dialog box and select AddSenderAddress as the script to run
  9. Click Finish

The last step is to modify the view by adding the user-defined field called SenderAddress. Wait until you’ve received at least one email before modifying the view. The user-defined field won’t exist until the rule has run the first time and created the field. Once a message has arrived, then follow these steps to add the field to the view.

  1. Go to the Inbox
  2. Click View > Current View > Customize Current View
  3. Click Fields
  4. Click the Select available fields pulldown and select User-defined fields in Inbox
  5. In Available fields select SenderAddress then click Add
  6. Use the Move Up and Move Down buttons to position the field where you want it
  7. Click OK twice

You should now see the sender’s email address in the view.

Advertisements

73 comments on “Adding the Sender’s Email Address to an Outlook View

  1. Hi David,
    I know this is an old thread but hoping you are still around. I had my logon moved to a different domain yesterday. I didn’t bring the script over with me but thankfully had this bookmarked. I copy and pasted the 2nd one in which is what I had been using before (hides the OU reference).It ran fine yesterday, but upon booting up today the senderaddress field will not populate. If I go into run the rule now it will run, but isn’t pulling in anything. Here is the current script as copied and pasted. Any help would be greatly appreciated!!

    Private Sub AddSenderAddress(Item As Outlook.MailItem)
        Dim olkPrp As Outlook.UserProperty, olkSnd As Outlook.AddressEntry, olkEnt As Object, strAdr As String
        On Error Resume Next
        Set olkSnd = Item.Sender
        If olkSnd.AddressEntryUserType = olExchangeUserAddressEntry Then
            Set olkEnt = olkSnd.GetExchangeUser
            strAdr = olkEnt.PrimarySmtpAddress
        Else
            strAdr = Item.SenderEmailAddress
        End If
        Set olkPrp = Item.UserProperties.Add("SenderAddress", olText, True)
        olkPrp.value = strAdr
        Item.Save
        On Error GoTo 0
        Set olkPrp = Nothing
        Set olkSnd = Nothing
        Set olkEnt = Nothing
    End Sub
    
  2. heyy.. for the revision 22 can you please add the date range as there for rev 4, so that i can run for a period with attachments being exported with log.?

    • Hi, Harish.

      Replace ExportMessagesToExcel with the version below. Leave the rest of the code from rev 22 as is. I think I made all the necessary changes, but I have not tested the code to make sure.

      Sub ExportMessagesToExcel()
          Dim olkMsg As Object, _
              olkAtt As Outlook.Attachment, _
              olkLst As Object, _
              excApp As Object, _
              excWkb As Object, _
              excWks As Object, _
              lngRow As Long, _
              intVer As Integer, _
              intCnt As Integer, _
              strFil As String, _
              strAtt As String, _
              strSav As String, _
              strRng As String, _
              objFSO As Object, _
              arrTmp As Variant, _
              datBeg As Date, _
              datEnd As Date
          strFil = InputBox("Enter a filename (including path) to save the exported messages to.", MACRO_NAME)
          If strFil <> "" Then
              strRng = InputBox("Enter the date range of the messages to export in the form ""mm/dd/yyyy to mm/dd/yyyy""", MACRO_NAME, Date & " to " & Date)
              arrTmp = Split(strRng, "to")
              datBeg = IIf(IsDate(arrTmp(0)), arrTmp(0), Date) & " 12:00am"
              datEnd = IIf(IsDate(arrTmp(1)), arrTmp(1), Date) & " 11:59pm"
              Set objFSO = CreateObject("Scripting.FileSystemObject")
              intVer = GetOutlookVersion()
              Set excApp = CreateObject("Excel.Application")
              Set excWkb = excApp.Workbooks.Add()
              Set excWks = excWkb.ActiveSheet
              'Write Excel Column Headers
              With excWks
                  .Cells(1, 1) = "Subject"
                  .Cells(1, 2) = "Received"
                  .Cells(1, 3) = "Sender"
                  .Cells(1, 4) = "To"
                  .Cells(1, 5) = "Attachments"
              End With
              lngRow = 2
              'Write messages to spreadsheet
              Set olkLst = Application.ActiveExplorer.CurrentFolder.Items.Restrict("[ReceivedTime] >= '" & Format(datBeg, "ddddd h:nn AMPM") & "'" & " AND [ReceivedTime] <= '" & Format(datEnd, "ddddd h:nn AMPM") & "'")
              For Each olkMsg In olkLst.Items
                  'Only export messages, not receipts or appointment requests, etc.
                  If olkMsg.Class = olMail Then
                      'Add a row for each field in the message you want to export
                      excWks.Cells(lngRow, 1) = olkMsg.Subject
                      excWks.Cells(lngRow, 2) = olkMsg.ReceivedTime
                      excWks.Cells(lngRow, 3) = GetSMTPAddress(olkMsg, intVer)
                      excWks.Cells(lngRow, 4) = olkMsg.To
                      strAtt = ""
                      For Each olkAtt In olkMsg.Attachments
                          If Not IsHiddenAttachment(olkAtt) Then
                              strAtt = strAtt & olkAtt.FileName & ", "
                              intCnt = 0
                              strSav = ATTACHMENT_PATH & olkAtt.FileName
                              Do While objFSO.FileExists(strSav)
                                  intCnt = intCnt + 1
                                  strSav = ATTACHMENT_PATH & "Copy (" & intCnt & ") of " & olkAtt.FileName
                              Loop
                              olkAtt.SaveAsFile strSav
                          End If
                      Next
                      If strAtt <> "" Then
                          strAtt = Left(strAtt, Len(strAtt) - 2)
                      End If
                      excWks.Cells(lngRow, 5) = strAtt
                      lngRow = lngRow + 1
                  End If
              Next
              Set olkMsg = Nothing
              excWkb.SaveAs strFil
              excWkb.Close
          End If
          Set objFSO = Nothing
          Set excWks = Nothing
          Set excWkb = Nothing
          Set excApp = Nothing
          MsgBox "Process complete.  A total of " & lngRow - 2 & " messages were exported.", vbInformation + vbOKOnly, MACRO_NAME
      End Sub
      

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s