Consulting

Results 1 to 9 of 9

Thread: code to get the email header

  1. #1
    VBAX Regular
    Joined
    Apr 2016
    Posts
    22
    Location

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

    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

  2. #2
    VBAX Regular
    Joined
    Apr 2016
    Posts
    22
    Location
    any help?

  3. #3
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  4. #4
    VBAX Regular
    Joined
    Apr 2016
    Posts
    22
    Location
    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?

  5. #5
    VBAX Regular
    Joined
    Apr 2016
    Posts
    22
    Location
    or maybe tell me how to get the inet headers and i can parse it how i like. can that be done?

  6. #6
    The function Function GetInetHeaders(olkMsg As Outlook.MailItem) As String on that page gets the header as a string.
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  7. #7
    VBAX Regular
    Joined
    Apr 2016
    Posts
    22
    Location
    thanks, now im working on searching the string variable. will post back when i have more questions. thanks gmayor for responding.

  8. #8
    VBAX Regular
    Joined
    Apr 2016
    Posts
    22
    Location
    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
    Last edited by danmc58; 10-02-2019 at 11:21 AM.

  9. #9
    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 Sub
    and run it from a rule that identifies the incoming messages.
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •