Question

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

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

包装摘要：

客户：XYZ

价格（美元）：3,000

时间：1周

项目ID：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）”，则仍然存储该值，而不应该存储该值。仅当找到匹配的文本时，才应存储该值。

我尝试了“（（价格（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，只需使用后处理步骤即可：

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

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

1 个答案: