vba 在两个静态字符串之间查找文本

Find text between two static strings

提问by Philip Crumpton

I parse message data into a CSV file via Outlook rules.

我通过 Outlook 规则将消息数据解析为 CSV 文件。

How can I take the example below and store the text under "Customer Log Update:" into a string variable?

如何使用下面的示例并将“客户日志更新：”下的文本存储到字符串变量中？

[Header Data]

Description: Problem: A2 - MI ERROR - R8036

Customer Log Update: I'm having trouble with order #458362. I keep getting Error R8036, can you please assist?

Thanks!

View problem at http://...
[Footer Data]

[标题数据]

描述：问题：A2 - MI ERROR - R8036

客户日志更新：我遇到了订单 #458362 的问题。我一直收到错误 R8036，你能帮忙吗？

谢谢！

查看问题在 http://...
[页脚数据]

Desired result to be stored into the string variable (note that the result may contain newlines):

需要存储到字符串变量中的结果（注意结果可能包含换行符）：

I'm having trouble with order #458362. I keep getting Error R8036, can you please assist?

Thanks!

我在订购 #458362 时遇到问题。我一直收到错误 R8036，你能帮忙吗？

谢谢！

I haven't attempted to code anything pertaining to my question.

我没有尝试编写任何与我的问题有关的代码。

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

采纳答案by Jean-Fran?ois Corbett

Why not something simple like this:

为什么不是这样简单的事情：

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

I tested it using this code and it worked:

我使用此代码对其进行了测试，并且有效：

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

回答by brettdj

While I would also go the more direct route like Jean-Fran?ois Corbett did as the parsing is very simple, you could apply the Regexp approach as below

虽然我也会像 Jean-Fran?ois Corbett 那样走更直接的路线，因为解析非常简单，你可以应用下面的 Regexp 方法

The pattern Update:([\S\s]+)viewsays match all characters between "Update" and "view" and return them as a submatch

该模式 Update:([\S\s]+)view表示匹配“更新”和“查看”之间的所有字符并将它们作为子匹配返回

This piece [\S\s]says match all non-whitespace or whitespace characters - ie everything. In vbscripta .matches everything buta newline, hence the need for the [\S\s]workaround for this application

这篇文章[\S\s]说匹配所有非空白或空白字符 - 即一切。在vbscript 中，a.匹配除换行符以外的所有内容，因此需要[\S\s]针对此应用程序的解决方法

The submatch is then extracted by objRegM(0).submatches(0)

然后通过提取子匹配 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