Header Statistics for outlook client

I currently have an antispam solution that is working fine.  However I recently have had a spike in the amount of email showing up in my junk email folder.  I believe if had the right data at hand I could probably block a few ips and nail 80% of the volume.  In order to do that I need to gather some statistics on the origin ips of items in my junk email.  I would like to find a tool that would allow me to point it my junk email folder and have it dig through all the messages headers an tally up the number of emails from each ip.  Alternatively if I could just export an excel file with the ip for each message then I can do the rollup myself.

Anyone aware of such a tool?  I googled for 30 minutes but there are so many antispam tools out there that I can't wade through it all. thanks
vizientAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

David LeeCommented:
Hi, vizient.

I might be able to help.  What version of Outlook are you using?
0
vizientAuthor Commented:
2007
0
David LeeCommented:
Ok, here's the code for this.  I'm not sure how accurate the results are because I've yet to find a hard and fast rule for parsing the sender's IP address from the header.  The principle I've applied here is it's the last bracketed IP address in line unless that address is 127.0.0.1 in which case it's the next to last address.

Follow these instructions to add the code to Outlook.

1.  Start Outlook
2.  Click Tools > Macro > Visual Basic Editor
3.  If not already expanded, expand Microsoft Office Outlook Objects
4.  If not already expanded, expand Modules
5.  Select an existing module (e.g. Module1) by double-clicking on it or create a new module by right-clicking Modules and selecting Insert > Module.
6.  Copy the code from the Code Snippet box and paste it into the right-hand pane of Outlook's VB Editor window
7.  Edit the code as needed.  I included comments wherever something needs to or can change
8.  Click the diskette icon on the toolbar to save the changes
9.  Close the VB Editor

To use this

1.  Select one or more messages
2.  Run the macro SearchInetHeaderForIP

The output is a text file with one address per line.  You can import that into Excel, Access, or some application that can sort and sum the results.
Sub SearchInetHeaderForIP()
    Dim olkItem As Outlook.MailItem, objRegEx As Object, colMatches As Object, objFSO As Object, objFile As Object, intIndex As Integer
    Dim strHeader As String, strTemp As String, strMatches As String
    Set objRegEx = CreateObject("VBScript.RegExp")
    With objRegEx
        .IgnoreCase = True
        .Pattern = "\[\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}\]"
        .Global = True
    End With
    For Each olkItem In Application.ActiveExplorer.Selection
        strHeader = GetInetHeaders(olkItem)
        Set colMatches = objRegEx.Execute(strHeader)
        For intIndex = (colMatches.count - 1) To 1 Step -1
            strTemp = Replace(colMatches.Item(intIndex), "[", "")
            strTemp = Replace(strTemp, "]", "")
            If strTemp <> "127.0.0.1" Then
                strMatches = strMatches & strTemp & vbCrLf
                Exit For
            End If
        Next
        Set colMatches = Nothing
        strTemp = ""
    Next
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    'Edit the file name and path on the next line'
    Set objFile = objFSO.CreateTextFile("c:\eeTesting\SenderIP.txt")
    objFile.Write strMatches
    objFile.Close
    Set objFile = Nothing
    Set objFSO = Nothing
    Set colMatches = Nothing
    Set objRegEx = Nothing
    Set olkItem = Nothing
    msgbox "Done"
End Sub

Function GetInetHeaders(olkMsg As Outlook.MailItem) As String
    ' Purpose: Returns the internet headers of a message.'
    ' Written: 4/28/2009'
    ' Author:  BlueDevilFan'
    ' Outlook: 2007'
    Const PR_TRANSPORT_MESSAGE_HEADERS = "http://schemas.microsoft.com/mapi/proptag/0x007D001E"
    Dim olkPA As Outlook.PropertyAccessor
    Set olkPA = olkMsg.PropertyAccessor
    GetInetHeaders = olkPA.GetProperty(PR_TRANSPORT_MESSAGE_HEADERS)
    Set olkPA = Nothing
End Function

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
The Ultimate Tool Kit for Technolgy Solution Provi

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy for valuable how-to assets including sample agreements, checklists, flowcharts, and more!

vizientAuthor Commented:
I think this is very close! I stepped through the code in debug mode and though your pulling ip addresses out...it appears that some of the time you are parsing out  their internal relays  (internal to sending company) occuring through multiple servers and these ips are being picked up.  I would attempt to modify the code myself but its been ages since I have touch regular expressions.  Heres a thought though the line where the ip I want should always look like this
([129.35.117.152]) by secure.vizient.com

where the by secure.vizient.com is always the same.  Could you key up on that?  Obviously to test you would need to find something static like that on an incoming email of your own.
0
David LeeCommented:
Ok, try this.
Sub SearchInetHeaderForIP()
    Dim olkItem As Outlook.MailItem, objRegEx As Object, colMatches As Object, objFSO As Object, objFile As Object, intIndex As Integer
    Dim strHeader As String, strTemp As String, strMatches As String
    Set objRegEx = CreateObject("VBScript.RegExp")
    With objRegEx
        .IgnoreCase = True
        .Pattern = "\(\[\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}\]\) by secure.vizient.com"
        .Global = True
    End With
    For Each olkItem In Application.ActiveExplorer.Selection
        strHeader = GetInetHeaders(olkItem)
        Set colMatches = objRegEx.Execute(strHeader)
        For intIndex = 0 To (colMatches.count - 1) Step -1
            strTemp = Replace(colMatches.Item(intIndex), "[", "")
            strTemp = Replace(strTemp, "]", "")
            If strTemp <> "127.0.0.1" Then
                strMatches = strMatches & strTemp & vbCrLf
                Exit For
            End If
        Next
        Set colMatches = Nothing
        strTemp = ""
    Next
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    'Edit the file name and path on the next line'
    Set objFile = objFSO.CreateTextFile("c:\eeTesting\SenderIP.txt")
    objFile.Write strMatches
    objFile.Close
    Set objFile = Nothing
    Set objFSO = Nothing
    Set colMatches = Nothing
    Set objRegEx = Nothing
    Set olkItem = Nothing
    msgbox "Done"
End Sub

Function GetInetHeaders(olkMsg As Outlook.MailItem) As String
    ' Purpose: Returns the internet headers of a message.'
    ' Written: 4/28/2009'
    ' Author:  BlueDevilFan'
    ' Outlook: 2007'
    Const PR_TRANSPORT_MESSAGE_HEADERS = "http://schemas.microsoft.com/mapi/proptag/0x007D001E"
    Dim olkPA As Outlook.PropertyAccessor
    Set olkPA = olkMsg.PropertyAccessor
    GetInetHeaders = olkPA.GetProperty(PR_TRANSPORT_MESSAGE_HEADERS)
    Set olkPA = Nothing
End Function

Open in new window

0
vizientAuthor Commented:
got it! Thanks!
0
David LeeCommented:
You're welcome.
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Outlook

From novice to tech pro — start learning today.