VBA查找substr与正则表达式

Question

我在Outlook（2003）中使用VBA通过Outlook规则解析消息数据到一个CSV文件。我如何拿下面的例子并将“客户日志更新：”下的文本存储到字符串变量中？

[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] 

期望的结果将被存储到字符串变量（注意，结果可能包含换行符）：

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

Thanks! 

谢谢！

编辑：根据要求，这是我到目前为止。请注意，我没有试图编写与我的问题有关的任何内容。完全卡住了。

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

为什么不能简单的东西是这样的：

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 

Answer 2

虽然我也喜欢去让 - 更直接的途径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