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)?
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