title: Extract IP Addresses in Email body
body: <p>I am trying to extract all IP addresses in the body of an Outlook message from the following <a href="https://www.slipstick.com/developer/vba-copy-outlook-email-excel-workbook/" rel="nofollow noreferrer">example</a>.</p>
  <p>I tried replacing the regex from:</p>
  <pre><code>With Reg1
      .Pattern = &quot;((P130\w*)\s*(\w*)\s*(\w*)\s*(\w*)\s*([\d-\.]*))&quot;
  End With
  </code></pre>
  <p>To:</p>
  <pre><code>With Reg1
      .Pattern = &quot;((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]?))&quot;
  End With
  </code></pre>
  <p><strike>But it only matches one octet.</strike></p>
  <p>Sample Text:</p>
  <pre><code>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.
  </code></pre>
  <p><strike>Currently it only matches <strong>168</strong></strike></p>
  <p>Added extra brackets and now matches the <strong>first</strong> IP in the body of the message but not the rest.</p>
  <p><strong>Full code below:</strong></p>
  <pre class="lang-vb prettyprint-override"><code>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(&quot;USERPROFILE&quot;))
  'the path of the workbook
   strPath = enviro &amp; &quot;\Documents\test.xlsx&quot;
       On Error Resume Next
       Set xlApp = GetObject(, &quot;Excel.Application&quot;)
       If Err &lt;&gt; 0 Then
           Application.StatusBar = &quot;Please wait while Excel source is opened ... &quot;
           Set xlApp = CreateObject(&quot;Excel.Application&quot;)
           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(&quot;Sheet1&quot;)
  
      'Find the next empty line of the worksheet
       rCount = xlSheet.Range(&quot;B&quot; &amp; xlSheet.Rows.Count).End(xlUp).Row
       rCount = rCount + 1
       
       sText = olItem.Body
  
       Set Reg1 = CreateObject(&quot;VBScript.RegExp&quot;)
      ' \s* = invisible spaces
      ' \d* = match digits
      ' \w* = match alphanumeric
       
      With Reg1
          ' .Pattern = &quot;((P130\w*)\s*(\w*)\s*(\w*)\s*(\w*)\s*([\d-\.]*))&quot;
           .Pattern = &quot;((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]?))&quot;
          '.Pattern = &quot;^(([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])$&quot;
          
      End With
      If Reg1.Test(sText) Then
       
      ' each &quot;(\w*)&quot; and the &quot;(\d)&quot; 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(&quot;B&quot; &amp; rCount) = vText
      xlSheet.Range(&quot;c&quot; &amp; rCount) = vText2
      xlSheet.Range(&quot;d&quot; &amp; rCount) = vText3
      xlSheet.Range(&quot;e&quot; &amp; rCount) = vText4
      xlSheet.Range(&quot;f&quot; &amp; 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
  </code></pre>