Outlook 2010 VBA - 使用 RegEx return 电子邮件正文中的多个匹配项

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

我每天都会收到多封电子邮件,正文中包含以下字符串:

[Spool File No. ####

其中 #### 是 1 到 2000 之间的整数

有时,正文中只有一个这样的字符串,有时会有更多,唯一的区别是整数。

作为一个整体,我是 VBA 的新手,但是为了找到包含整数的字符串并输出一个带有整数值的 msgbox,我想出了以下内容,但是我需要找到所有实例具有多个整数值的电子邮件的匹配项。

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

这应该匹配所有出现的 [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