Forward All Headers from Outlook from a Button

There are times that you want to forward all headers an from Outlook email message. Usually this would be to report Spam. In the headers are the information necessary to block the offending email message. Since things like a return address can be (and frequently are) spoofed, the headers are the only definitive way of tracking these offenders.

You can get the headers by opening the message, then selecting File/Info/Properties from the menu. However, if the message is spam, I usually prefer not opening the message as there have been vulnerabilities in Outlook that allow malicious code to run. It's paranoia, but just because I'm paranoid doesn't mean they aren't out to get me. It is also tedious to copy the headers from the dialog and paste them into a message.

I have created a little code that allows creating an email message with just the headers from a press of a button. With a little more work, I could add the body of the message. It is just a little bit tricky, because an email message can contain really two bodies: a plain text body, and a HTML mail body. You could also add the attachments, if any. This code doesn't do either of those...it just creates an email message with the headers.

It opens the message in the editor so you can add a recipient and subject line. These could be automated if you knew the recipient, and then the message could be automatically saved and sent, which would place it in the outbox.

The code appears below. To add this code to Outlook, you need to bring up the VBA editor. The easiest way to do that is to press Alt+F11 on the keyboard. Then Insert Module, add the code, and save it.

Then assign the code to a Quick Access Toolbar button. Click on the little button at the end of the Toolbar called Customize Quick Access Toolbar. Select "More Commands" from the menu. Select "Macros" from the "Choose commands from" drop-down list. Then pick "ForwardHeaders" from the list, and click the Add button. You can modify the icon, if you like, by pressing the "Modify..." button.

Select one or more email messages. Click the button.

Here is the code:

Option Explicit

Public Sub ForwardHeaders()
    'From blog.xoc.net, written by Greg Reddick
    Dim selection As Outlook.selection
    Dim mail As Outlook.MailItem
    Dim i As Long
    Const PR_TRANSPORT_MESSAGE_HEADERS = "http://schemas.microsoft.com/mapi/proptag/0x007D001E"
    Dim headers As String
    Dim sendMessage As Outlook.MailItem
    
    Set selection = Application.ActiveExplorer.selection
    For i = 1 To selection.Count
        If selection.Item(i).Class = OlObjectClass.olMail Then
            Set mail = selection.Item(i)
            headers = mail.PropertyAccessor.GetProperty(PR_TRANSPORT_MESSAGE_HEADERS)
            Set sendMessage = Application.CreateItem(olMailItem)
            With sendMessage
                .Body = headers
                .display
            End With
            Set sendMessage = Nothing
            Set mail = Nothing
        End If
    Next i
    Set selection = Nothing
End Sub