Extrahieren Sie IP-Adressen in Microsoft Outlook mithilfe von Makros

Question

Ich versuche, ALL IP-Adressen in den Text einer Outlook-Nachricht aus dem folgenden Beispiel here extrahieren.

Ich habe versucht, aus dem regex ersetzen:

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

An:

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 

Aber sie paßt nur ein Oktett.

Beispieltext:

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. 

Derzeit nur paßt es

Added zusätzliche Klammern und jetzt paßt die ersten IP im Körper der Nachricht, aber nicht die andere.

Voll Code unten:

 

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?