VBA-在電子郵件正文或主題中查找字符串

Question

我正在嘗試創建一個簡單的宏，該宏讀取活動的電子郵件並檢查是否存在某個字符串。 現在，字符串可以有兩種可能的格式，並且僅包含數字。

兩種格式：

xxx-xxxxxxxx或xxxxxxxxxxx （x始終是數字）

我不確定如何執行此操作。 在下面，我有一個宏，它讀取郵件-但只能找到特定的字符串 ：

Sub AutomateReplyWithSearchString()

    Dim myInspector As Outlook.Inspector
    Dim myObject As Object
    Dim myItem As Outlook.MailItem
    Dim myDoc As Word.Document
    Dim mySelection As Word.Selection
    Dim strItem As String
    Dim strGreeting As String

    Set myInspector = Application.ActiveInspector
    Set myObject = myInspector.CurrentItem

    'The active inspector is displaying a mail item.
    If myObject.MessageClass = "IPM.Note" And myInspector.IsWordMail = True Then
        Set myItem = myInspector.CurrentItem

        'Grab the body of the message using a Word Document object.
        Set myDoc = myInspector.WordEditor
        myDoc.Range.Find.ClearFormatting
        Set mySelection = myDoc.Application.Selection
        With mySelection.Find

            .Text = "xxx-xxxxxxxx"
            .Replacement.Text = ""
            .Forward = True
            .Wrap = wdFindContinue
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchAllWordForms = False
            .MatchSoundsLike = False
            .MatchWildcards = True

        End With

        If mySelection.Find.Execute = True Then
            strItem = mySelection.Text

            'Mail item is in compose mode in the inspector
            If myItem.Sent = False Then
                strGreeting = "With reference to " + strItem
                myDoc.Range.InsertBefore (strGreeting)
            End If
        Else
            MsgBox "There is no item number in this message."

        End If
    End If
    End Sub

Answer 1

您可以使用正則表達式模式：

(\d{11}|\d{3}-\d{8})

試試吧。

此示例從此處復制。 我還沒有測試。

Option Explicit

Sub GetValueUsingRegEx()
 ' Set reference to VB Script library
 ' Microsoft VBScript Regular Expressions 5.5

    Dim olMail As Outlook.MailItem
    Dim Reg1 As RegExp
    Dim M1 As MatchCollection
    Dim M As Match

    Set olMail = Application.ActiveExplorer().Selection(1)
   ' Debug.Print olMail.Body

    Set Reg1 = New RegExp

    With Reg1
        .Pattern = "(\d{11}|\d{3}-\d{8})"
        .Global = True
    End With
    If Reg1.test(olMail.body) Then

        Set M1 = Reg1.Execute(olMail.body)
        For Each M In M1
            Debug.Print M.SubMatches(1)

        Next
    End If

End Sub