Open Notes

Есть несколько способов поиска определённого текста в теле письма с помощью VBA. Можно воспользоваться функциями InStr, Len, Left или Right, чтобы найти и извлечь текст, а можно воспользоваться регулярными выражениями. Именно о применении регулярных выражений в коде VBA пойдёт речь в данной статье.

Например, требуется извлечь код отслеживания посылки UPS, отправленной с Amazon.com. Такой код имеет формат как на скриншете ниже:

Нужно находить в тексте слова «Carrier Tracking ID», затем, возможно, пробел и двоеточие.

.Pattern = "(Carrier Tracking ID\s*[:]+\s*(\w*)\s*)"

Такое выражение извлечёт из текста из примера цифро-буквенный код 1Z2V37F8YW51233715.

Используйте \s* для определения неизвестного количества пробелов (пробелы, символы табуляции, перевода строки и т.д.)
Используйте \d* для определения только цифр
Используйте \w* для определения цифро-буквенных символов, как используются в кодах отслеживания посылок UPS.

Чтобы использовать этот образец кода откройте редактор VBA с помощью комбинации Alt+F11. Правой кнопкой мыши нажмите на Проекте и выберите Insert > Module. Скопируйте и вставьте код макроса в модуль. Для работы макроса нужно задействовать библиотеку Microsoft VBScript Regular Expressions 5.5 в меню Tools -> References… VBA-редактора:

Если включена библиотека VBScript Expressions 1, то отключите её сняв соответствующую галочку. Невозможно одновременно использовать v1 и v5.5.

Sub GetValueUsingRegEx()
 ' Подключите библиотеку VB Script
 ' 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
 
    ' \s* = скрытые пробелы
    ' \d* = цифры
    ' \w* = цифро-буквенные выражения
 
    With Reg1
        .Pattern = "Carrier Tracking ID\s*[:]+\s*(\w*)\s*"
        .Global = True
    End With
    If Reg1.test(olMail.Body) Then
 
        Set M1 = Reg1.Execute(olMail.Body)
        For Each M In M1
            ' M.SubMatches(1) is the (\w*) in the pattern
            ' use M.SubMatches(2) for the second one if you have two (\w*)
            Debug.Print M.SubMatches(1)
 
        Next
    End If
 
End Sub

Если будем искать только двоеточие .Pattern ="([:]+\s*(\w*)\s*)", тогда код вернёт только первое слово после двоеточия из каждой строки:

UPS
May
Standard
1Z2V37F8YW51233715
Diane

Это потому, что (\w*) указывает, что нужно получить следующую после двоеточия цифро-буквенную строку, не всю строку, и не включать пробелы.

Получение двух и более значений из сообщения

Если вам требуется использовать два или несколько шаблонов, то можно повторить часть c With Reg1 до End If, для каждого из шаблонов или воспользоваться оператором Case.

Код ниже осуществляет поиск по трём шаблонам, создает строку и добавляет ее в поле темы сообщения. Каждый Case представляет свой шаблон. В этом примере отыскивается только первое вхождение каждого шаблона. .Global = False указывает, что нужно остановиться, когда находится первое совпадение.

Данные, которые мы ищем имеют следующий формат:

Order ID : VBNSA-123456
Order Date: 09 AUG 2013
Total $54.65

/n в конце шаблона соответствует концу строки, а strSubject = Replace(strSubject, Chr(13), "") удаляет любые переносы строки.

Sub GetValueUsingRegEx()
    Dim olMail As Outlook.MailItem
    Dim Reg1 As RegExp
    Dim M1 As MatchCollection
    Dim M As Match
    Dim strSubject As String
    Dim testSubject As String
 
    Set olMail = Application.ActiveExplorer().Selection(1)
 
    Set Reg1 = New RegExp
 
For i = 1 To 3
 
With Reg1
    Select Case i
    Case 1
        .Pattern = "(Order ID\s[:]([\w-\s]*)\s*)\n"
        .Global = False
 
    Case 2
       .Pattern = "(Date[:]([\w-\s]*)\s*)\n"
       .Global = False
 
    Case 3
        .Pattern = "(([\d]*\.[\d]*))\s*\n"
        .Global = False
    End Select
 
End With
 
 
    If Reg1.test(olMail.Body) Then
 
        Set M1 = Reg1.Execute(olMail.Body)
        For Each M In M1
            Debug.Print M.SubMatches(1)
            strSubject = M.SubMatches(1)
 
         strSubject = Replace(strSubject, Chr(13), "")
         testSubject = testSubject & "; " & Trim(strSubject)
         Debug.Print i & testSubject
 
         Next
    End If
 
Next i
 
Debug.Print olMail.Subject & testSubject
olMail.Subject = olMail.Subject & testSubject
olMail.Save
 
Set Reg1 = Nothing
 
End Sub

Использование функции RegEx

Эта функция позволяет использовать регулярное выражение в более чем одном макросе.

Если вам нужно использовать более чем один шаблон с функцией, задайте для шаблон в макросе regPattern = "([0-9]{4})" и используйте это в функции: regEx.Pattern = regPattern. Не забудьте добавить Dim regPattern As String в верхней части модуля.

Function ExtractText(Str As String) ' As String
 Dim regEx As New RegExp
 Dim NumMatches As MatchCollection
 Dim M As Match
 
'этот шаблон ищет 4 подряд идущие цифры в теме письма
 regEx.Pattern = "([0-9]{4})"
 
' используейте это, если нужно задвать разные шаблоны
' regEx.Pattern = regPattern
 
 Set NumMatches = regEx.Execute(Str)
 If NumMatches.Count = 0 Then
      ExtractText = ""
 Else
 Set M = NumMatches(0)
     ExtractText = M.SubMatches(0)
 End If
 code = ExtractText
 End Function

Этот макрос показывает, как использовать функцию Regex. Если в теме письма есть соответствующая шаблону комбинация (в пример функции, 4-х значное число), то будет создан ответ. Если нет, то появляется окно с сообщением. Чтобы использовать функцию с разными макросами, раскомментируйте строки, содержащие regPattern.

Dim code As String
'Dim regPattern As String
 
Sub RegexTest()
 
Dim Item As MailItem
Set Item = Application.ActiveExplorer.Selection.Item(1)
 
' используйте для передачи шаблона в функцию
'regPattern = "([0-9]{4})"
 
ExtractText (Item.Subject)
 
If Not code = "" Then
Set myReply = Item.Reply
myReply.Display
 
Else
MsgBox "Тема не содержит 4-х значного числа"
End If
 
End Sub

Источник

Полезные ссылки

• Regular Expression Syntax (Scripting)
• RegExLib.com — Regular Expression Cheat Sheet (.NET)