Just about anyone who runs mail servers needs to look at headers from time to time. This is especially true during the development of product such as Exchange, as we track down and fix bugs. I wrote this little macro to make that a little easier. Select a message, click the button to run the macro, and it will copy the headers from the message into the clipboard as well as open up notepad with the headers.
As always happens when I post my amateurish macros, I am expecting someone to come along and make it better :-) Every time that happens, I learn more about VBA. (Some day I really should take the time to actually learn it instead of just futzing around.)
There are two versions here: One is for Outlook 2007 only, the other for Outlook 2003 (and I assume it would also work with OL2K but haven't tried it myself). Thanks to Randy for telling me about the PropertyAccessor in OL2K7.
Sub KCsCopyHeadersOL2K7()'Takes the currently selected message, copies the internet headers'of it to the clipboard & opens notepad with the headers as well. Dim MessageHeader As String Dim dataObject As MSForms.dataObject Set dataObject = New dataObject
Const PR_TRANSPORT_MESSAGE_HEADERS = "http://schemas.microsoft.com/mapi/proptag/0x007D001E" Dim oMail As Outlook.MailItem If Application.ActiveExplorer.Selection.Count = 1 Then If Application.ActiveExplorer.Selection(1).Class = olMail Then Set oMail = Application.ActiveExplorer.Selection(1) MessageHeader = oMail.PropertyAccessor.GetProperty(PR_TRANSPORT_MESSAGE_HEADERS) If MessageHeader <> "" Then dataObject.SetText MessageHeader dataObject.PutInClipboard Dim fso As New FileSystemObject Dim ts As TextStream Dim strRandFilename As String 'Note: Vista won't let you write to C:\, change this to somewhere else strRandFilename = "C:\" & Left(Rnd * 100000, 4) & ".txt" Set ts = fso.OpenTextFile(strRandFilename, ForWriting, True) ts.Write (MessageHeader) ts.Close Shell "notepad.exe " & strRandFilename End If End If End IfEnd Sub
Sub KCsCopyHeadersOL2K3()'Takes the currently selected message, copies the internet headers'of it to the clipboard & opens notepad with the headers as well. Dim dataObject As MSForms.dataObject Dim strInternetHeaders As String Dim objSession As MAPI.Session Dim objExplorer As Outlook.Explorer Dim objSelection As Outlook.Selection Set objSession = CreateObject("MAPI.Session") Set objExplorer = ThisOutlookSession.ActiveExplorer Set objSelection = objExplorer.Selection Dim objItem As Outlook.MailItem Dim objMessage As MAPI.Message objSession.Logon "", "", False, False Set objItem = objSelection.Item(1) Set objMessage = objSession.GetMessage(objItem.EntryID, objItem.Parent.StoreID) strInternetHeaders = objMessage.Fields.Item(CdoPR_TRANSPORT_MESSAGE_HEADERS).Value Set dataObject = New dataObject dataObject.SetText strInternetHeaders dataObject.PutInClipboard Dim fso As New FileSystemObject Dim ts As TextStream Dim strRandFilename As String strRandFilename = "c:\" & Left(Rnd * 100000, 4) & ".txt" Set ts = fso.OpenTextFile(strRandFilename, ForWriting, True) ts.Write (strInternetHeaders) ts.Close Shell "notepad.exe " & strRandFilename End Sub
P.S. putting my name in the macros is a nod to/way of poking fun at Jensen Harris, who wrote an application that a lot of people use internally and the app is very well branded - "Office Buddy by Jensen Harris".