Get Outlook's Internet Headers using VBA

Use this code sample and function to display the Internet header of selected message in a new message form.

Tested in Outlook 2013, also works in Outlook 2010 and 2007. For Outlook 2003 and older, see Get Internet header VBA code sample for Outlook 2003.

Sub ViewInternetHeader()
    Dim olItem As Outlook.MailItem, olMsg As Outlook.MailItem
    Dim strheader As String

    For Each olItem In Application.ActiveExplorer.Selection
        strheader = GetInetHeaders(olItem)
    
        Set olMsg = Application.CreateItem(olMailItem)
        With olMsg 
            .BodyFormat = olFormatPlain
            .Body = strheader
            .Display
        End With
    Next
    Set olMsg = Nothing
End Sub

Function GetInetHeaders(olkMsg As Outlook.MailItem) As String
    ' Purpose: Returns the internet headers of a message.'
    ' Written: 4/28/2009'
    ' Author:  BlueDevilFan'
    ' //techniclee.wordpress.com/
    ' Outlook: 2007'
    Const PR_TRANSPORT_MESSAGE_HEADERS = "http://schemas.microsoft.com/mapi/proptag/0x007D001E"
    Dim olkPA As Outlook.PropertyAccessor
    Set olkPA = olkMsg.PropertyAccessor
    GetInetHeaders = olkPA.GetProperty(PR_TRANSPORT_MESSAGE_HEADERS)
    Set olkPA = Nothing
End Function

Get Specific Values from the header

But combining RegEx and the macro above we can get specific values out of the header. In this example, we're getting the address in the Return-Path.

If you need two or more values, you'll use a Case statement to loop through the header. See Get two (or more) values from a message for an example.

Sub GetValuesFromInternetHeader()
    Dim olItem As Outlook.MailItem, olMsg As Outlook.MailItem
    Dim strHeader As String
    Dim strResult As String
    Dim strResults As String
    Dim Reg1 As Object
    Dim M1 As Object
    Dim M As Object
 
    For Each olItem In Application.ActiveExplorer.Selection
        strHeader = GetInetHeaders(olItem)
    
      Set Reg1 = CreateObject("VBScript.RegExp")
    With Reg1
        .Pattern = "(Return-Path:\s(.*))"
        .Global = True
    End With
    
    If Reg1.test(strHeader) Then
    
        Set M1 = Reg1.Execute(strHeader)
        For Each M In M1
' 0 = everything in the first set of ()
' 1 = everything in the second set of ()
        Debug.Print M.SubMatches(0)
        strResult = M.SubMatches(1)

' do something with the result
        strResults = strResult & vbCrLf & vbCrLf & strResults
        Next
    End If
    
    Next

        Set olMsg = Application.CreateItem(olMailItem)
        With olMsg
            .BodyFormat = olFormatPlain
            .Body = strResults
            .Display
        End With
    Set olMsg = Nothing
End Sub

Function GetInetHeaders(olkMsg As Outlook.MailItem) As String
    ' Purpose: Returns the internet headers of a message.'
    ' Written: 4/28/2009'
    ' Author:  BlueDevilFan'
    ' //techniclee.wordpress.com/
    ' Outlook: 2007'
    Const PR_TRANSPORT_MESSAGE_HEADERS = "http://schemas.microsoft.com/mapi/proptag/0x007D001E"
    Dim olkPA As Outlook.propertyAccessor
    Set olkPA = olkMsg.propertyAccessor
    GetInetHeaders = olkPA.GetProperty(PR_TRANSPORT_MESSAGE_HEADERS)
    Set olkPA = Nothing
End Function

Send a Spam Report

If you need to send a spam report to your ISP, you can use a macro to automate it. This macro will work on one message or a selection of messages.

Sub ForwardSpam()
    Dim olItem As Outlook.MailItem, olMsg As Outlook.MailItem
    Dim strHeader As String
    Dim strFWHeader As String
    Dim strNote As String

    For Each olItem In Application.ActiveExplorer.Selection
        strHeader = GetInetHeaders(olItem)

    strNote = "boilerplate note, if needed"
        
      Set olMsg = olItem.Forward
       With olMsg
        .To = "report@address.com"
        .BodyFormat = olFormatPlain
        .Body = strNote & vbCrLf & vbCrLf & strHeader & vbCrLf & vbCrLf & olItem.Body
        .Display ' change to .send when satisfied
       End With
    olItem.Delete
  Next
    Set olMsg = Nothing
End Sub

Function GetInetHeaders(olkMsg As Outlook.MailItem) As String
    ' Purpose: Returns the internet headers of a message.'
    ' Written: 4/28/2009'
    ' Author:  BlueDevilFan'
    ' //techniclee.wordpress.com/
    ' Outlook: 2007'
    Const PR_TRANSPORT_MESSAGE_HEADERS = "http://schemas.microsoft.com/mapi/proptag/0x007D001E"
    Dim olkPA As Outlook.propertyAccessor
    Set olkPA = olkMsg.propertyAccessor
    GetInetHeaders = olkPA.GetProperty(PR_TRANSPORT_MESSAGE_HEADERS)
    Set olkPA = Nothing
End Function

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:

1. Right click on Project1 and choose Insert > Module
2. Copy and paste the macro into the new module.

More information as well as screenshots are at How to use the VBA Editor