Извлечь IP-адреса в Microsoft Outlook с помощью макросов

Question

Я пытаюсь извлечь ВСЕ IP-адреса в теле сообщения Outlook из следующего примера here.

Я попытался заменить регулярные выражения из:

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 

Но это соответствует только один октет.

Образец текста:

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. 

В настоящее время он соответствует только

Добавлены дополнительные скобки, и теперь соответствует первый IP в теле сообщения, но не до конца.

Полный код ниже:

 

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 

Answer 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?