Есть несколько способов поиска определённого текста в теле письма с помощью 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)