Найти текст между двумя статическими строками

Question

Я анализирую данные сообщения в файл CSV с помощью правил Outlook.

Как я могу взять приведенный ниже пример и сохранить текст в разделе «Customer Log Update:» в строковую переменную?

[Данные заголовка]

Описание: Проблема: A2 - MI ERROR - R8036

Обновление журнала клиента: У меня проблемы с заказом № 458362. Я продолжаю получать сообщение об ошибке R8036, не могли бы вы помочь?

Спасибо!

Просмотр проблемы на http: //...
[Данные нижнего колонтитула]

Желаемый результат для сохранения в строковой переменной (обратите внимание, что результат может содержать переводы строки):

У меня проблемы с заказом № 458362. Я продолжаю получать сообщение об ошибке R8036, не могли бы вы помочь?

Спасибо!

Я не пытался закодировать что-либо, относящееся к моему вопросу.

Function RegFind(RegInput, RegPattern)
Dim regEx As New VBScript_RegExp_55.RegExp
Dim matches, s
regEx.Pattern = RegPattern
regEx.IgnoreCase = True
regEx.Global = False
s = ""
If regEx.Test(RegInput) Then
    Set matches = regEx.Execute(RegInput)
    For Each Match In matches
        s = Match.Value
    Next
    RegFind = s
Else
    RegFind = ""
End If
End Function

Sub CustomMailMessageRule(Item As Outlook.MailItem)

MsgBox "Mail message arrived: " & Item.Subject

Const FileWrite = file.csv `file destination

Dim FF1 As Integer
Dim subj As String
Dim bod As String

On Error GoTo erh

subj = Item.Subject
'this gets a 15 digit number from the subject line
subj = RegFind(subj, "\d{15}")

bod = Item.Body
'following line helps formatting, lots of double newlines in my source data
bod = Replace(bod, vbCrLf & vbCrLf, vbCrLf)

'WRITE FILE
FF1 = FreeFile
Open FileWrite For Append As #FF1
    Print #FF1, subj & "," & bod
Close #FF1

Exit Sub

erh:
    MsgBox Err.Description, vbCritical, Err.Number

End Sub

Answer 1

Хотя я бы также пошел более прямым путем, как Жан-Франсуа Корбетт, поскольку синтаксический анализ очень прост, вы можете применить метод регулярных выражений, как показано ниже

Узор Update:([\S\s]+)view говорит, что сопоставить все символы между «Обновление» и «представление» и вернуть их как подстать

Этот фрагмент [\S\s] говорит, что соответствует всем непробельным или пробельным символам - то есть всему. В vbscript a . соответствует все , но перевод строки, следовательно, для этого приложения требуется обходной путь [\S\s]

Затем субматч извлекается objRegM(0).submatches(0)

Function ExtractText(strIn As String)
    Dim objRegex As Object
    Dim objRegM As Object
    Set objRegex = CreateObject("vbscript.regexp")
    With objRegex
        .ignorecase = True
        .Pattern = "Update:([\S\s]+)view"
        If .test(strIn) Then
            Set objRegM = .Execute(strIn)
            ExtractText = objRegM(0).submatches(0)
        Else
            ExtractText = "No match"
        End If
    End With
End Function

Sub JCFtest()

Dim messageBody As String
Dim result As String
messageBody = "Description: Problem: A2 - MI ERROR - R8036" & vbCrLf & _
              "Customer Log Update:" & _
              "I 'm having trouble with order #458362.  I keep getting Error R8036, can you please assist?" & vbCrLf & _
              "Thanks!" & vbCrLf & _
              "View problem at http://..."


MsgBox ExtractText(messageBody)

End Sub

Answer 2

Почему бы не что-то простое, как это:

Function GetCustomerLogUpdate(messageBody As String) As String
    Const sStart As String = "Customer Log Update:"
    Const sEnd As String = "View problem at"
    Dim iStart As Long
    Dim iEnd As Long

    iStart = InStr(messageBody, sStart) + Len(sStart)
    iEnd = InStr(messageBody, sEnd)

    GetCustomerLogUpdate = Mid(messageBody, iStart, iEnd - iStart)
End Function

Я протестировал его, используя этот код, и он работал:

Dim messageBody As String
Dim result As String

messageBody = "Description: Problem: A2 - MI ERROR - R8036" & vbCrLf & _
    "Customer Log Update:" & vbCrLf & _
    "I 'm having trouble with order #458362.  I keep getting Error R8036, can you please assist?" & vbCrLf & _
    "Thanks!" & vbCrLf & _
    "View problem at http://..." 

result = GetCustomerLogUpdate(messageBody)

Debug.Print result