Whilst working in VBA in Microsoft Outlook, I decided to make a function to extract IP addresses from the headers of an email. This is mainly used for reporting spam, but I am sure it could be put to many other good uses!
If you use it, please leave me a comment with details on how you are using it.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 |
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 |