code to get the email header

[danmc58]

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

[danmc58]

any help?

[gmayor]

Take a look at https://www.slipstick.com/developer/code-samples/outlooks-internet-headers/

[danmc58]

Thanks Gmayor, this is getting me closer. my only issue with this code (and it works to get the senders email address) is that it uses Regex which is something i know zip zero zilch about. can you help me with that?

so what i need are the following:
Senders Email Address
To Email Address(es)
From Email Address(es)
CC Email Address(es)
BCC Email Address(es)
Subject line
Body contents in a searchable variable
Attachment names

i think that here is the relevant code from the link that you supplied


Set Reg1 = CreateObject("VBScript.RegExp") With Reg1
.Pattern = "(Return-Path:\s(.*))"
.Global = True
End With

is that something that can be done?

[danmc58]

or maybe tell me how to get the inet headers and i can parse it how i like. can that be done?

[gmayor]

The function Function GetInetHeaders(olkMsg As Outlook.MailItem) As String on that page gets the header as a string.

[danmc58]

thanks, now im working on searching the string variable. will post back when i have more questions. thanks gmayor for responding.

[danmc58]

ok, so now i have some questions. i am able to pull the sender, to, subject and names of attachments. the problem is that the procedure is running on the selected item and not the new incoming email. how can i fix that?

turns out the GetAttachmentList procedure is picking up the current selection, how can i make that run for incoming emails?



Public Sub GetAttachmentList()
Dim selItem As Object
Dim aMail As MailItem
Dim aAttach As attachment
Dim Report As String

For Each selItem In Application.ActiveExplorer.Selection
If selItem.Class = olMail Then
Set aMail = selItem
For Each aAttach In aMail.Attachments
'Report = Report & vbCrLf & "------------------------------------------------------------------------" & vbCrLf
Report = Report & GetAttachmentInfo(aAttach)
Next
Call CreateReportEmail("Attachment Report", Report)
End If
Next
End Sub

[gmayor]

Change the code to

Public Sub GetAttachmentList(olItem As MailItem)
Dim aAttach As Attachment
Dim Report As String


If TypeName(olItem) = "MailItem" Then
For Each aAttach In olItem.Attachments
Report = Report & GetAttachmentInfo(aAttach)
Next
Call CreateReportEmail("Attachment Report", Report)
End If
End Suband run it from a rule that identifies the incoming messages.