Поиск просматриваемой электронной почты по определенной фразе, извлечение строки для копирования в буфер обмена

Question

Я получаю назначения в электронных письмах, поступающих в общий почтовый ящик Outlook.

В типичном электронном письме есть несколько строк и переменных, касающихся клиента, включая их имя, дату и идентификатор с дефисом, который мне тоже нуженчтобы избавиться от.

Есть два типа идентификаторов.Оба состоят из 8 чисел и дефиса, например, 1234567-8 и 123456-78.Иногда перед числом стоит символ, поэтому я считаю, что хранить данные в виде строки просто необходимо.Я хочу сделать несколько копий макроса для каждого типа данных.Я хочу, чтобы все это было в простой строковой форме, поскольку я хочу скопировать его в буфер обмена и вставить в другое место, и нет необходимости обрабатывать его дальше.

Приведенный ниже код выполняет все, что я хочу, за исключением того, что вместо этого данные хранятся в переменныхстроки и не удаляет дефис.

Код предоставлен vbaexpress 'gmayor.

Option Explicit

Sub GetCustomer()
Dim olItem As Outlook.MailItem
Dim olInsp As Outlook.Inspector
Dim dCust As DataObject
Dim wdDoc As Object
Dim oRng As Object
Dim sCustomer As String
Dim bFound As Boolean
    On Error GoTo lbl_Exit
    Set olItem = ActiveExplorer.Selection.Item(1)
    With olItem
        Set olInsp = .GetInspector
        Set wdDoc = olInsp.WordEditor
        Set oRng = wdDoc.Range
        With oRng.Find
            Do While .Execute(findText:="Customer #:[ 0-9]{2,}", MatchWildcards:=True)
                sCustomer = Trim(Split(oRng.Text, Chr(58))(1))
                bFound = True
                Set dCust = New DataObject
                dCust.SetText sCustomer
                dCust.PutInClipboard
                MsgBox "Customer number '" & sCustomer & "' copied to clipboard"
                Exit Do
            Loop
        End With
        If Not bFound Then MsgBox "Customer number not found"
    End With
lbl_Exit:
    Set olItem = Nothing
    Set olInsp = Nothing
    Set wdDoc = Nothing
    Set oRng = Nothing
    Set dCust = Nothing
    Exit Sub
End Sub

Я хочу найти просматриваемое в настоящий момент электронное письмо (если это возможно), фактически не открывая егов другом отдельном окне для фразы типа

"Customer ID:           123456-78"

и переформатируйте последнюю часть, просто удалив дефис и игнорируя первую часть

"Customer ID:           " 

(междуИдентификатор клиента и номер).

Я также хочу переформатировать дату с 11.22.2019 по 2019-22-11, а также скопировать ее в буфер обмена.

Answer 1

Поиск, основанный на подстановочных знаках, ограничен тем, что могут предоставить подстановочные знаки, что лучше, чем ничего, но все же не очень много.

Для этого Outlook использует функции Word, поэтому применяется документация VBA для Word .Сами применимые символы подстановки можно увидеть с помощью кнопки «Специальные» в диалоговом окне «Найти» (F4 в Outlook) после того, как флажок «использовать символы подстановки».

Насколько мне известно, понятия «необязательно»«части в подстановочных поисках, что означает, что вам нужно использовать несколько шаблонов, чтобы покрыть ваш случай« иногда есть буква впереди ».

Так что общий подход основан на этих знаниях и на вашем примере кода, будет

• Выберите текущий выбранный MailItem в ActiveExplorer
• Для каждого предопределенного шаблона подстановочного знака
  • сбросьте диапазон поиска для всего электронного письма
  • выполнить поиск по шаблону
  • , пока есть результаты поиска
    • показать результат, позволить пользователю выбрать или отменить поиск

Таким образом, можно определить несколько паттернов, и у вас есть шанс перейти к следующему удару, если первый удар окажется ложноположительным.

Я нашел паттерн [0-9-]{8;9} plus MatchWholeWord доРаботает достаточно хорошо (блоки цифр и тире, длиной от 8 до 9 символов), но реальные данные часто бывают неожиданными.Вам, вероятно, нужно будет добавить больше шаблонов.Обратите внимание: для меня Outlook хочет ; вместо ,.Это может зависеть от локали системы, я не уверен.

Также я не фанат "тихого" On Error Resume.Если есть ошибка, я предпочитаю видеть фактическое сообщение об ошибке.Если есть условие, которое можно проверить, чтобы предотвратить ошибку, я предпочитаю проверять это условие явно.Это делает код более надежным и облегчает отладку.По этой причине в моем Sub нет строки On Error.

В коде это будет выглядеть так:

Sub GetCustomer()
    Dim olItem As Outlook.MailItem
    Dim oRng As Object
    Dim sCustomer As String
    Dim patterns As Variant, pattern As Variant
    Dim answer As VbMsgBoxResult

    ' bail out if the preconditions are not right
    If ActiveExplorer.Selection.Count = 0 Then Exit Sub
    If Not (TypeOf ActiveExplorer.Selection.item(1) Is MailItem) Then Exit Sub

    Set olItem = ActiveExplorer.Selection.item(1)
    Set oRng = olItem.GetInspector.WordEditor.Range

    ' add more wildcard patterns in descending order of likelyhood
    patterns = Array("[0-9-]{8;9}", "[A-Z][0-9-]{8;9}")

    For Each pattern In patterns
        oRng.WholeStory
        While oRng.Find.Execute(findText:=pattern, MatchWildcards:=True, MatchWholeWord:=True)
            answer = MsgBox(oRng.Text, vbYesNoCancel + vbQuestion, "Customer Number")
            If answer = vbYes Then
              With New DataObject
                  .SetText oRng.Text
                  .PutInClipboard
              End With
              Exit For
            ElseIf answer = vbCancel Then
              Exit For
            End If
        Wend
    Next pattern
End Sub

Установка переменных в Nothing в концефункция лишняя.