正则表达式 – 使用宏在Microsoft Outlook中提取IP地址

我试过替换正则表达式：

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

至：

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.

目前它只匹配168

添加了额外的括号,现在匹配邮件正文中的第一个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 & "Documentstest.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 = "((P130w*)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