Extract IP Addresses in Email body

Question

I am trying to extract all IP addresses in the body of an Outlook message from the following example.

I tried replacing the regex from:

With Reg1
    .Pattern = "((P130\w*)\s*(\w*)\s*(\w*)\s*(\w*)\s*([\d-\.]*))"
End With

To:

With Reg1
    .Pattern = "((25[0-5]|2[0-4][0-9]|[01]?[0-9][0-9]?)\.(25[0-5]|2[0-4][0-9]|[01]?[0-9][0-9]?)\.(25[0-5]|2[0-4][0-9]|[01]?[0-9][0-9]?)\.(25[0-5]|2[0-4][0-9]|[01]?[0-9][0-9]?))"
End With

~~But it only matches one octet.~~

Sample Text:

The IP from 192.168.10.2 needs attention.
The IP from 192.168.11.3 needs attention.
The IP from 192.168.12.4 needs attention.

Currently it only matches 168

Added extra brackets and now matches the first IP in the body of the message but not the rest.

Full code below:

Option Explicit
Private Const xlUp As Long = -4162

Sub CopyToExcel(olItem As Outlook.MailItem)
 Dim xlApp As Object
 Dim xlWB As Object
 Dim xlSheet As Object
 Dim vText, vText2, vText3, vText4, vText5 As Variant
 Dim sText As String
 Dim rCount As Long
 Dim bXStarted As Boolean
 Dim enviro As String
 Dim strPath As String
 Dim Reg1 As Object
 Dim M1 As Object
 Dim M As Object
              
enviro = CStr(Environ("USERPROFILE"))
'the path of the workbook
 strPath = enviro & "\Documents\test.xlsx"
     On Error Resume Next
     Set xlApp = GetObject(, "Excel.Application")
     If Err <> 0 Then
         Application.StatusBar = "Please wait while Excel source is opened ... "
         Set xlApp = CreateObject("Excel.Application")
         bXStarted = True
     End If
     On Error GoTo 0
     'Open the workbook to input the data
     Set xlWB = xlApp.Workbooks.Open(strPath)
     Set xlSheet = xlWB.Sheets("Sheet1")

    'Find the next empty line of the worksheet
     rCount = xlSheet.Range("B" & xlSheet.Rows.Count).End(xlUp).Row
     rCount = rCount + 1
     
     sText = olItem.Body

     Set Reg1 = CreateObject("VBScript.RegExp")
    ' \s* = invisible spaces
    ' \d* = match digits
    ' \w* = match alphanumeric
     
    With Reg1
        ' .Pattern = "((P130\w*)\s*(\w*)\s*(\w*)\s*(\w*)\s*([\d-\.]*))"
         .Pattern = "((25[0-5]|2[0-4][0-9]|[01]?[0-9][0-9]?)\.(25[0-5]|2[0-4][0-9]|[01]?[0-9][0-9]?)\.(25[0-5]|2[0-4][0-9]|[01]?[0-9][0-9]?)\.(25[0-5]|2[0-4][0-9]|[01]?[0-9][0-9]?))"
        '.Pattern = "^(([0-9]|[1-9][0-9]|1[0-9]{2}|2[0-4][0-9]|25[0-5])\.){3}([0-9]|[1-9][0-9]|1[0-9]{2}|2[0-4][0-9]|25[0-5])$"
        
    End With
    If Reg1.Test(sText) Then
     
    ' each "(\w*)" and the "(\d)" are assigned a vText variable
        Set M1 = Reg1.Execute(sText)
        For Each M In M1
           vText = Trim(M.SubMatches(1))
           vText2 = Trim(M.SubMatches(2))
           vText3 = Trim(M.SubMatches(3))
           vText4 = Trim(M.SubMatches(4))
           ' vText5 = Trim(M.SubMatches(5))
        Next
    End If

    xlSheet.Range("B" & rCount) = vText
    xlSheet.Range("c" & rCount) = vText2
    xlSheet.Range("d" & rCount) = vText3
    xlSheet.Range("e" & rCount) = vText4
    xlSheet.Range("f" & rCount) = vText5

     xlWB.Close 1
     If bXStarted Then
         xlApp.Quit
     End If
     Set M = Nothing
     Set M1 = Nothing
     Set Reg1 = Nothing
     Set xlApp = Nothing
     Set xlWB = Nothing
     Set xlSheet = Nothing
End Sub

0m3r · Accepted Answer · 2017-02-15T01:45:46.793

1

^(([0-9]|[1-9][0-9]|1[0-9]{2}|2[0-4][0-9]|25[0-5])\.){3}([0-9]|[1-9][0-9]|1[0-9]{2}|2[0-4][0-9]|25[0-5])$

http://www.regextester.com/22

Regular expression to match DNS hostname or IP Address?

edited Feb 15 '17 at 01:45

answered Feb 15 '17 at 01:40

0m3r

12,286
15
35
71

No joy with that but I added extract brackets on my original expression and it appears to match the full IP now. Thanks for your input. – pablo808 Feb 15 '17 at 01:43

Extract IP Addresses in Email body

1 Answers1