• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 2962
  • Last Modified:

Outlook VBA Code to extract eMail Headers

I would like to be able extract the email headers of a selected sub-folder in Outlook to a CSV/TXT file (or Excel SS) using VBA code with each header as a separate record - or line entry. Have only looked quickly at Outlook's VBA reference. Hopefully this is not complicated... Any help out there for this?
0
DanielT
Asked:
DanielT
  • 7
  • 6
1 Solution
 
DanielTAuthor Commented:
ipaulino
Thanks for link. Looks interesting but there is no reference to eMail header info in code - only generic fields such as from, to, subj etc. I am looking to obtain the IP information that is contained in the email header "header" if that's what we can call it. This also outputs to clipboard which would be fine sometimes but not when I have a larger number of emails to scan.
0
 
DanielTAuthor Commented:
Have increased points...
No VBA programmers out there?

Any help for how to step through a selected email folder and capture email header info from each email as you go, writing info extracted to a CSV file?
0
NEW Veeam Agent for Microsoft Windows

Backup and recover physical and cloud-based servers and workstations, as well as endpoint devices that belong to remote users. Avoid downtime and data loss quickly and easily for Windows-based physical or public cloud-based workloads!

 
Chris BottomleyCommented:
I need to think a bit but I believe it's possible ... how do you expect the folder to be selected, i.e. static selection before running the macro or dynamic with the user defining the directory at run-time?

Chris
0
 
DanielTAuthor Commented:
Hi Chris,

Simply (easily said) by processing emails within the currently selected folder - which I believe is what you are saying as static selection. Then, to capture the email headers so that I can then extract IP info to assist in filtering unwanted sources of email. FYI - since from what I understand it will be needed, I have installed Redemption but have not had time to get into it.
0
 
Chris BottomleyCommented:
Okay, first off I am not sure how the IP can be identified ... by header I assumed subject, date etc., apologies the info was in the thread.

I will look further to see how the IP can be accessed, I assume it is required for legitimate users since if youre trying to identify fraudsters I understand the IP address to be easily falsified.  Out of interest when identifying valid users you could also use the email addresses themselves, i.e. the domain part ... though i'll assume there are specific reasons for using the IP and will continue to look it up.

Wouldn't expect to need redemption per se but cant see it doing any harm either, (need to check there for IP handling as well).

Chris
0
 
Chris BottomleyCommented:
OK, can isolate the IP addresses, it does require redemption as you thought and to validate I am addressing the first IP address in the header.  As far as I know this represents the sender, i.e I am excluding all intermediate IP adresses.  Is that right?

Note I have only evaluated the IP gathering at the moment hence the finished loop will take  alittle longer.

Chris
0
 
Chris BottomleyCommented:
Daniel

Re-using some valuable work by colleagues, (and a bit of VBA glue) I have an outline for you as follows.  If you look in the immediate pane of the VBA editor it will show you the IP addresses in each email in the current directory.  i.e. if it works for you then all that is left is the relatively simple act of copying it to excel ... just seeking some confirmation that the work so far looks ok.  If you need an assist with running it then please ask.

Sub this_folder()
Dim outlook_app As Outlook.Application
Dim ol_ns As Outlook.NameSpace
Dim ol_folder As Object
Dim obj_Item As Object
Dim safe_email As Redemption.SafeMailItem
Dim ol_email As Outlook.MailItem
Dim inet_header As Double
Dim inet_datum As String
Dim inet_datums() As String
Dim inet_coll As New Collection
Dim datum_count As Integer

    inet_header = &H7D001E
    Set outlook_app = CreateObject("outlook.application")
    Set ol_ns = outlook_app.GetNamespace("mapi")
    Set ol_folder = outlook_app.ActiveExplorer.CurrentFolder
    If Not ol_folder Is Nothing Then
        For Each obj_Item In ol_folder.Items
            If obj_Item.Class = olMail Then
                Set safe_email = CreateObject("redemption.safemailitem")
                safe_email.Item = obj_Item
                inet_datum = safe_email.Fields(inet_header)
                inet_datums = GetIPAddresses(inet_datum)
                For datum_count = 1 To UBound(inet_datums)
                    On Error Resume Next
                    inet_coll.Add Item:=inet_datums(datum_count), key:=inet_datums(datum_count)
                Next
                If inet_coll.Count <> 0 Then
                    For datum_count = 1 To inet_coll.Count
                        Debug.Print datum_count & ". " & inet_coll.Item(datum_count) & "."
                    Next
                End If
                If inet_coll.Count <> 0 Then
                    For datum_count = 1 To inet_coll.Count
                        On Error Resume Next
                        inet_coll.Remove (1)
                    Next
                End If
            End If
            Debug.Print "---------------------------"
        Next
    End If
Set outlook_app = Nothing
Set ol_ns = Nothing
Set ol_folder = Nothing
Set safe_email = Nothing
End Sub
Function GetIPAddresses(ByVal MsgHeader As String) As String()
 Dim tempArr() As String, i As Long, RegEx As Object, RegC As Object
 Set RegEx = CreateObject("vbscript.regexp")
 ReDim tempArr(0)
 With RegEx
  .Global = True
  .MultiLine = True
  .Pattern = "\[?(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})\]?"
 End With
 If RegEx.Test(MsgHeader) Then
  Set RegC = RegEx.Execute(MsgHeader)
  ReDim tempArr(RegC.Count - 1)
  For i = 0 To RegC.Count - 1
   tempArr(i) = RegC.Item(i).SubMatches(0)
  Next
 End If
 Set RegEx = Nothing
 Set RegC = Nothing
 GetIPAddresses = tempArr
End Function

Regards
Chris
0
 
DanielTAuthor Commented:
Hi Chris,

You've been busy! Thanks.
I will not have time to check this for a bit.

I had found that the IP address in the header when there is an entry named X-Originating-IP: [xxx.xxx.xxx.xxx] it seems to be valid but I am nowhere near an expert on this. It has just matched when checked to the expected domain or has been from a common area sending spam even if to isolate by a pertial IP such as [111.222.].
0
 
Chris BottomleyCommented:
I will await your feedback in respect of the IP gathering and any analysis that might help improve the performance to that which you would like.

The supplied routine ought to always return full IP addresses.  If there is filtering needed on the returned data then that probably ought to be within the excel element ... would not want to overload outlook too much as you want to limit processing that might interfere with it's primary function of mail gathering.

Chris
0
 
DanielTAuthor Commented:
Not much of an update.... just to say I have not abandoned this.
Hopefully I can get to it soon...
0
 
Chris BottomleyCommented:
Still here!

Chris
0
 
DanielTAuthor Commented:
Chris - still do not have time to pursue but I APPRECIATE the VBA code you posted and your assistance. I may be able to figure it out from there anyway so thanks! Am accepting your solution even though I have been unable to try it.
0
 
Chris BottomleyCommented:
Hoe it lives up to your expectations when you get down to it

Chris
0

Featured Post

Prep for the ITIL® Foundation Certification Exam

December’s Course of the Month is now available! Enroll to learn ITIL® Foundation best practices for delivering IT services effectively and efficiently.

  • 7
  • 6
Tackle projects and never again get stuck behind a technical roadblock.
Join Now