The following is the Get Internet Header code sample from Teach Yourself Outlook in 24 Hours. This code requires CDO and will not work with Outlook 2010 or Outlook 2013. CDO can be downloaded from Microsoft for use with Outlook 2007.
For an Outlook 2010/2013 version, see Get Outlook's Internet Headers using VBA
If you prefer installing a ready-to-use add-in, try PocketKnife Peek.
Copy and paste the code from this page into your ThisOutlookSession project.
To do this, click in the text box, Select All using Ctrl+A, Ctrl+C to copy.
In Outlook, press Alt+F11 to open the VBA editor and expand Microsoft Outlook Objects then double click on ThisOutlookSession to open it in the editing pane and Ctrl+V to paste the code.
The form this code uses is here.
Public Sub GetInternetHeaders() ' Initalize error handling On Error Resume Next ' Declare constants Const CdoPR_TRANSPORT_MESSAGE_HEADERS = &H7D001E Dim objSession As New MAPI.Session Dim objExplorer As Outlook.Explorer Dim objSelection As Outlook.Selection Dim objItem As Outlook.MailItem 'Object Dim objMessage As MAPI.Message Dim objFields As MAPI.Fields Dim strheader As String Dim InetHeader As New MSForms.DataObject ' MAPI property tag used objSession.Logon , , False, False, 0 ' Use the existing Outlook session Set objExplorer = ThisOutlookSession.ActiveExplorer Set objSelection = objExplorer.Selection ' Get selected Message ID Set objItem = objSelection.Item(1) Set objMessage = objSession.GetMessage(objItem.EntryID, objItem.Parent.StoreID) ' Get message fields Set objFields = objMessage.Fields ' Get SMTP header Err.Clear strheader = objFields.Item(CdoPR_TRANSPORT_MESSAGE_HEADERS).Value If Err.Number = 0 Then 'MsgBox strheader ' Get the message body, prefer the raw HTML if it exists If objItem.HTMLBody = "" Then msgHeader = strheader & objItem.Body Else msgHeader = strheader & objItem.HTMLBody End If ' Note that you must have a form in the project for this reference to work InetHeader.SetText (msgHeader) InetHeader.PutInClipboard frmHeader.txtHeader.Text = msgHeader frmHeader.Show Else MsgBox "No SMTP message header information on this message", vbInformation End If ' Logoff from CDO 1.21 sesison objSession.Logoff ' Tidy up Set objExplorer = Nothing Set objSelection = Nothing Set objItem = Nothing Set objSession = Nothing Set objMessage = Nothing Set objFields = Nothing Set objField = Nothing End Sub
I would like to be able to do this in Outlook 2010 and Outlook 2013, and am disappointed the above code will not work.
Use this one -Get internet headers. You won't be disappointed.