Regex 使用宏在Microsoft Outlook中提取IP地址

我试图从下面的示例中提取Outlook邮件正文中的所有IP地址

我已尝试从以下位置替换正则表达式：

With Reg1
    .Pattern = "((P130\w*)\s*(\w*)\s*(\w*)\s*(\w*)\s*([\d-\.]*))"
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.

目前它只匹配168

添加了额外的括号，现在与邮件正文中的第一个IP匹配，但与其余IP不匹配

下面的完整代码：

---

这并不令人高兴，但我在原始表达式中添加了提取括号，现在它似乎与完整IP匹配。谢谢你的意见。

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.

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

^(([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])$