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

我试图从下面的例子中提取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

---

^(([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

正则表达式匹配DNS主机名或IP地址？

链接地址: http://www.djcxy.com/p/38001.html

上一篇: Extract IP Addresses in Microsoft Outlook using macros

下一篇: WPF BusyWindow unbreakable by main thread