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

Extract IP Address From E-mail Header in outlook using VBA

Hello All.

I need to try and get the IP Address of the sender of every mail item received using vba.

I have a 'macro' whichs fires each time an e-mail item is received, and I am able to access the full internet header information using 'Outlook redemption'.

However I would like to strip the senders IP address from the header and place it into another e-mail.

The headers are often quite complicated and may contain more then one IP so I am having touble figuring out how to do this.

An example header:

Microsoft Mail Internet Headers Version 2.0
Received: from netpilot.***.co.uk ([192.168.18.1]) by ***.co.uk with Microsoft SMTPSVC(6.0.3790.0);
         Thu, 1 Jun 2006 09:44:10 +0100
Received: by netpilot.***.co.uk (Postfix, from userid 27)
        id E089923B8F; Thu,  1 Jun 2006 09:46:08 +0100 (BST)
Received: from mail01-***.cleanport.com (unknown [192.168.0.1])
        by netpilot.***.co.uk (Postfix) with ESMTP id 67BCB23B8E
        for <mike@***.co.uk>; Thu,  1 Jun 2006 09:46:07 +0100 (BST)
Received: from (unresolved) ([192.168.0.2] HELO=smtpout.***.com)
        by mail01-***.uk.cleanport.com (CleanSMTPd 1.5.5) with ESMTP
        id 447F29AF-0 for <mike@***.co.uk>;
        Thu, 01 Jun 2006 10:46:03 +0200
Received: from [192.168.0.3] (helo=***.sbs)
        by smtpout.***.comwith esmtp (Exim 4.30)
        id 1Fliod-0002uX-6k server-id smtp-in2
        for mike@***.co.uk; Thu, 01 Jun 2006 09:46:03 +0100
Subject: test
MIME-Version: 1.0
Content-Type: multipart/alternative;
        boundary="----_=_NextPart_001_01C68556.A85D3440"
Date: Thu, 1 Jun 2006 09:37:46 +0100
Message-ID: <3060B2138A85554AA3888557FA3E73E2050739@adsserver.ads.sbs>
X-MimeOLE: Produced By Microsoft Exchange V6.0.6249.0
content-class: urn:content-classes:message
X-MS-Has-Attach:
X-MS-TNEF-Correlator:
Thread-Topic: test
Thread-Index: AcaFVZz9x8Llg/FPEdqSOwBQ2jyEkA==
From: "***" <***@***-uk.org>
To: <mike@***.co.uk>
X-Email-Filter-2B-F6-5F: 3.1.5 netpilot.***.co.uk
X-Spam-Level-2B-F6-5F:
X-Spam-Checker-Version-2B-F6-5F: SpamAssassin 2.64 (2004-01-11) on
        netpilot.***.co.uk
X-Spam-Flag-2B-F6-5F: NO
X-Spam-Status-2B-F6-5F: hits=-4.7 tests=BAYES_00,HTML_70_80,HTML_MESSAGE autolearn=no
        version=2.64
X-Spam-Key-2B-F6-5F: (-4.7 points in total)
X-Spam-Key-2B-F6-5F: -4.9 BAYES_00               BODY: Bayesian spam probability is 0 to 1%
                            [score: 0.0000]
X-Spam-Key-2B-F6-5F: 0.1 HTML_70_80             BODY: Message is 70% to 80% HTML
X-Spam-Key-2B-F6-5F: 0.1 HTML_MESSAGE           BODY: HTML included in message
X-Spam-Reclassify-2B-F6-5F: https://netpilot.***.co.uk/secure-admin?mod=spamassassin-reclassify&mid=1149151567.1722924367

X-Virus-Checked-2B-F6-5F: 0 Anti-virus engine 4.02.0, released 06 February 2006, 119637 virus identities.
Return-Path: ***@***.org
X-OriginalArrivalTime: 01 Jun 2006 08:44:10.0576 (UTC) FILETIME=[8D4A8D00:01C68557]

------_=_NextPart_001_01C68556.A85D3440
Content-Type: text/plain;
        charset="iso-8859-1"
Content-Transfer-Encoding: quoted-printable

------_=_NextPart_001_01C68556.A85D3440
Content-Type: text/html;
        charset="iso-8859-1"
Content-Transfer-Encoding: quoted-printable



------_=_NextPart_001_01C68556.A85D3440--

0
MikeSel
Asked:
MikeSel
  • 2
1 Solution
 
[ fanpages ]IT Services ConsultantCommented:
Retrieving an IP address that is prefixed with "192.168." is probably not going to be much use anyway (unless you are inside the sender's network).
0
 
MikeSelAuthor Commented:
Sorry I removed the 'Real' IP addresses and replaced them with 192's to protect the senders details etc
0
 
mvidasCommented:
Hi Mike,

Which IP are you looking for? All of them?

Heres a function which returns an array of addresses found in the header using regular expressions:

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


Sample usage:
 Dim IPAddrs() As String
 IPAddrs = GetIPAddresses(theHeader)
 If Len(IPAddrs(0)) > 0 Then
  MsgBox Join(IPAddrs, vbCrLf)
 End If


If there is a way to determine which one address you want based on some part of the header, let me know and I can update the pattern.  Please let me know if there is anything else!

Matt
0
 
MikeSelAuthor Commented:
Works a treat!!

Thanks for all your help!
0

Featured Post

How to Use the Help Bell

Need to boost the visibility of your question for solutions? Use the Experts Exchange Help Bell to confirm priority levels and contact subject-matter experts for question attention.  Check out this how-to article for more information.

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