One should always examine the Internet Header of a suspicious email. Yet, when Microsoft upgraded Outlook, this has become more difficult than just right-clicking and choosing View Header. Instead, you'll first have to open the message (a cringe-worthy action), and then navigate to File and Properties as described here.
I can never remember the procedure. Besides, I want to see the header before I open the message!
So I wrote a macro that displays the beginning of the header in a message box. Then it offers the choice of whether to copy the header content to the clipboard, which would allow for pasting into a new message to the IT department (for example).
Then I added a button to Quick Launch and bound it to the macro. The upshot is that I can select the message in my Inbox list of messages, press the button, and see the header!
Here's the code, which I couldn't have completed without the help of the Slipstick code sample. Please be careful of unintended wrapping of code, particularly for the value of PR_TRANSPORT_MESSAGE_HEADERS constant!
Sub HeaderReview()
' Copy Message Header contents of selected Mail Item to the Windows Clipboard.
' See: https://www.slipstick.com/developer/code-samples/outlooks-internet-headers/
' 2020-01-23 LG Created from CopyToClipboard dated 12/13/04
Dim objCB As New DataObject ' Clipboard object
Dim ol As New Outlook.Application
Dim oe As Outlook.Explorer
Dim mi As Outlook.MailItem
Dim strMH As String ' Mail Header
Set oe = ol.ActiveExplorer
If oe.CurrentFolder.DefaultItemType = olMailItem Then
Const PR_TRANSPORT_MESSAGE_HEADERS = "http://schemas.microsoft.com/mapi/proptag/0x007D001E"
Dim olkPA As Outlook.PropertyAccessor
Dim i As Integer
Set mi = oe.Selection.Item(1)
Set olkPA = mi.PropertyAccessor
strMH = olkPA.GetProperty(PR_TRANSPORT_MESSAGE_HEADERS)
Debug.Print strMH
i = MsgBox(strMH, vbYesNo, "Copy Message Header to Clipboard?")
Select Case i
Case vbYes
objCB.SetText strMH
objCB.PutInClipboard
End Select
Else
MsgBox "Sorry, HeaderReview() supports only Mail items at this time.", _
, "HeaderReview() Help"
End If
End Sub
