时间戳

首页 > 解决方案 > Excel VBA Regex 用于获取具有特定文本的值

regex - Excel VBA Regex 用于获取具有特定文本的值

问题描述

我是 vba 的新手，并试图解决我收到多封邮件的情况，如下所示：

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

包装摘要：

客户：XYZ

价格（美元）：3,000

时间：1周

项目编号：21312

还有一些文字......

在这里，我们想获取客户、价格 (USD)、时间、项目 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：如果标题价格 (USD) 更改为价格 (GBP) 仍然在存储价值，这是不应该的。只有找到匹配的文本时，它才应该存储该值。

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

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

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

或者建议任何更好的方法。

标签： regexvbaregex-group

解决方案

您可以使用

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.

查看正则表达式演示

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

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

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

推荐阅读