Question

我正尝试从以下示例here中提取Outlook邮件正文中的所有 IP地址。

我尝试过替换正则表达式：

With Reg1
    .Pattern = "((P130\w*)\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 & "\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?

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

1 个答案: