Excel VBA 用于获取具有特定文本的值的正则表达式

Question

我是 vba 的新手，正在尝试解决我收到如下多封邮件的情况：

我们想在 excel 中为我的特定文件夹中的所有邮件创建一个数据库

包裹摘要：

客户：XYZ

价格（美元）：3,000

时间：1 周

项目编号：21312

还有一些文字……

这里我们要获取客户、价格（美元）、时间、项目 ID 的信息。

已尝试使用以下代码捕获信息并存储在 excel 文件中。

Sub GetFromOutlook()

Dim OutlookApp As Outlook.Application
Dim OutlookNamespace As Namespace
Dim Folder As MAPIFolder
Dim OutlookMail As Variant
'Dim i As Integer

Set OutlookApp = New Outlook.Application
Set OutlookNamespace = OutlookApp.GetNamespace("MAPI")
Set Folder = OutlookNamespace.GetDefaultFolder(olFolderInbox).Folders("Dummy").Folders("New Dummy")

'i = 1

For Each OutlookMail In Folder.Items

    Dim sText As String

    sText = OutlookMail.Body
    Dim Reg1 As RegExp
    Dim M1 As MatchCollection
    Dim M As Match
    Dim vText, vText2, vText3, vText4 As Variant
    Dim i As Integer

    Set Reg1 = New RegExp

   ' \s* = invisible spaces
   ' \d* = match digits
   ' \w* = match alphanumeric
       For i = 1 To 9

            With Reg1
                Select Case i
                Case 1
                    .Pattern = "(Client[:]([\w-\s]*)\s*)\n"
                    .Global = False                    
                Case 2
                    .Pattern = "(([\d]*\,[\d]*))\s*\n"
                    .Global = False
                Case 3
                    .Pattern = "(Time[:]([\w-\s]*)\s*)\n"
                    .Global = False
                Case 4
                    .Pattern = "(Project Id[:]([\w-\s]*)\s*)\n"
                    .Global = False

                End Select

            End With

              If Reg1.Test(sText) Then
                Set M1 = Reg1.Execute(sText)
                 Select Case i
                          Case 1
                              For Each M In M1
                                  vText = Trim(M.SubMatches(1))
                              Next
                          Case 2
                              For Each M In M1
                                  vText2 = Trim(M.SubMatches(1))
                              Next
                          Case 3
                              For Each M In M1
                                  vText3 = Trim(M.SubMatches(1))
                              Next
                          Case 4
                              For Each M In M1
                                  vText4 = Trim(M.SubMatches(1))
                              Next

                End Select

              End If
        Next i

    Range("a1000").End(xlUp).Offset(1, 0).Value = vText
    Range("b1000").End(xlUp).Offset(1, 0).Value = vText2
    Range("c1000").End(xlUp).Offset(1, 0).Value = vText3
    Range("d1000").End(xlUp).Offset(1, 0).Value = vText4
Next OutlookMail

Set Folder = Nothing
Set OutlookNamespace = Nothing
Set OutlookApp = Nothing

End Sub

挑战：

挑战 1： 如果标题 Price (USD) 更改为 Price (GBP) 仍然存储值，这不应该。它应该只在找到匹配的文本时才存储值。

我试过 "(Price (USD) [:] ([\d]\,[\d]))\s*\n" 但它不起作用。

挑战2：对于项目id，值也带有下划线，我无法排除。

如果有人能帮助我解决我的代码中的上述 2 个挑战，我将不胜感激。

或者提出更好的方法。

Answer 1

您可以使用

Client:\s*(.*)[\r\n][\s\S]*?^Price \(USD\):\s*(.*)[\r\n][\s\S]*?^Time:\s*(.*)[\r\n][\s\S]*?^Project Id:\s*(\w+)

确保设置 Reg1.Multiline = True.

见regex demo

客户详细信息将在 M.SubMatches(0)（第 1 组）中，价格信息将在 M.SubMatches(1)（第 2 组）中，时间详细信息将在 M.SubMatches(2)（第 3 组）中，并且项目 ID 将在 M.SubMatches(3)（第 4 组）中。

如果您需要从第 4 组（项目 ID）中删除下划线，只需使用 post-processing 步骤：

vText4 = Replace(M.SubMatches(3), "_", "")

Excel VBA 用于获取具有特定文本的值的正则表达式

Excel VBA Regex for fetching the values which has specific text

regex

vba

regex-group