Option Explicit
Sub ViewInternetHeader()
Dim olItem As Outlook.MailItem, olMsg As Outlook.MailItem
Dim olkPA As Outlook.PropertyAccessor
Dim strheader As String
For Each olItem In Application.ActiveExplorer.Selection
strheader = GetInetHeaders(olItem)
MsgBox getMessageId(strheader)
Next
Set olMsg = Nothing
End Sub
Function GetInetHeaders(olkMsg As Outlook.MailItem) As String
Dim olkPA As Outlook.PropertyAccessor
Set olkPA = olkMsg.PropertyAccessor
GetInetHeaders = olkPA.GetProperty(PR_TRANSPORT_MESSAGE_HEADERS)
Set olkPA = Nothing
End Function
Function getMessageId(s As String) As String
Dim lngStart As Long, lngStop As Long
lngStart = InStr(1, s, "Message-ID:")
lngStop = InStr(lngStart, s, Chr(62))
getMessageId = Mid(s, lngStart, 1 + lngStop - lngStart)
End Function