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