code to get the email header
i have some code that prints to the immediate window the exchange header if found. that works great for in-house messages. but if the email is from another source, then it error's out (Im trapping that) with error 5. how can i get the headers of anyone's email with VBA (if possible)?
Code:
Function GetSender() As String
Dim Exp As Outlook.Explorer
Dim ItemCrnt As MailItem
Dim PropAccess As Outlook.PropertyAccessor
Dim arr As Variant
Dim x, y As Double, z
Dim a, b, c, e, f
Set Exp = Outlook.Application.ActiveExplorer
Dim count As Long
On Error GoTo errhandler
If Exp.Selection.count = 0 Then
Debug.Print "No emails selected"
Else
For Each ItemCrnt In Exp.Selection
With ItemCrnt
Set PropAccess = .PropertyAccessor
arr = PropAccess.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x007D001E")
y = InStr(arr, "From:")
z = InStr(arr, "To:")
a = Mid(arr, y, z - y)
b = InStr(a, "<")
e = InStr(a, ">")
c = Mid(a, b + 1, e - b - 1)
'Stop
GetSender = c
Debug.Print arr
End With
Next
End If
errhandler:
If Err.Number = 5 Then
Debug.Print "Not an exchange server email"
Else
If Err.Number <> 0 Then Debug.Print Err.Number & " " & Err.Description
End If
End Function