regexvbaemailoutlookmultiple-matches

Outlook 2010 VBA - Using RegEx to return multiple matches within email body


I receive multiple emails daily that have the following string within the body:

[Spool File No. ####

where #### is an integer anywhere from 1 to 2000

Sometimes, there is only one such string within the body, sometimes there are more with the only difference being the integer.

I am new to VBA as a whole, but have come up with the following in order to find the string containing the integer and output a msgbox with the integer value, however I need to find all instances of the match for the emails that have more than one integer value.

Sub Find_Spool_Number()
  Dim olMail As Outlook.MailItem
  Dim re1 As String
  re1 = "(\[)"  'Any Single Character 1
  Dim re2 As String
  re2 = "((?:[a-z][a-z]+))" 'Word 1
  Dim re3 As String
  re3 = "(\s+)" 'White Space 1
  Dim re4 As String
  re4 = "((?:[a-z][a-z]+))" 'Word 2
  Dim re5 As String
  re5 = "(\s+)" 'White Space 2
  Dim re6 As String
  re6 = "((?:[a-z][a-z]+))" 'Word 3
  Dim re7 As String
  re7 = "(\.)"  'Any Single Character 2
  Dim re8 As String
  re8 = "(\s+)" 'White Space 3
  Dim re9 As String
  re9 = "(\d+)" 'Integer Number 1
Set olMail = Application.ActiveExplorer().Selection(1)
  Dim r As New RegExp

  With r
  .Pattern = re1 + re2 + re3 + re4 + re5 + re6 + re7 + re8 + re9
  .IgnoreCase = True
  .MultiLine = False
  .Global = True
  End With

  Dim m As MatchCollection
  Set m = r.Execute(olMail.Body)
  If m.Item(0).SubMatches.Count > 0 Then
      Dim c1
      c1 = m.Item(0).SubMatches.Item(0)
      Dim word1
      word1 = m.Item(0).SubMatches.Item(1)
      Dim ws1
      ws1 = m.Item(0).SubMatches.Item(2)
      Dim word2
      word2 = m.Item(0).SubMatches.Item(3)
      Dim ws2
      ws2 = m.Item(0).SubMatches.Item(4)
      Dim word3
      word3 = m.Item(0).SubMatches.Item(5)
      Dim c2
      c2 = m.Item(0).SubMatches.Item(6)
      Dim ws3
      ws3 = m.Item(0).SubMatches.Item(7)
      Dim int1
      int1 = m.Item(0).SubMatches.Item(8)
      MsgBox ("" + c1 + "" + "" + word1 + "" + "" + ws1 + "" + "" + word2 + "" + "" + ws2 + "" + "" + word3 + "" + "" + c2 + "" + "" + ws3 + "" + "" + int1 + "" + "")

     Dim MyData As DataObject
     Set MyData = New DataObject

    MyData.SetText int1
    MyData.PutInClipboard

  End If
End Sub

Solution

  • This should match the digits found in all occurrences of [Spool File No. XXXX:

    Dim r As New RegExp
    r.Pattern = "\[Spool File No\. (\d{1,4})"
    r.Global = True
    
    Dim m As Match, c As MatchCollection
    Set c = r.Execute(olMail.Body)
    
    For Each m In c
        MsgBox m.SubMatches(0)
    Next