Question

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

如何使用下面的示例并将“Customer Log Update：”下的文本存储到字符串变量中？

[标题数据]

描述：问题：A2 - MI错误 - 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

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

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

这篇文章[\S\s]表示匹配所有非空格或空格字符 - 即所有内容。在vbscript中，.匹配所有但换行符，因此需要此应用程序的[\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

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

2 个答案: