regex - VBA 宏运行时错误

Question

我正在编写 VBA 代码，以从 Outlook 电子邮件中获取文本并将其放入我设置的 Excel 工作表中。我使用的是 Excel 2010。我的电子邮件包含 以下信息:

公司:ABC公司
上课时间:2013年10月29日至2014年10月22日

我已经设置了一个 For With 循环来遍历电子邮件并在 A 列中插入公司名称，在 B 列中插入第一个日期 (2013-10-29)，以及另一个日期 (2014-10-22)当我运行代码时，我收到一条错误，指出:运行时错误 5:以下代码行中的过程调用或参数无效: vText2 = Trim(M.SubMatches(2))

你能让我知道我做错了什么吗？我的部分代码如下。如果我需要提供任何其他信息，请告诉我。

sText = olItem.Body

Set Reg1 = CreateObject("VBScript.RegExp")

For i = 1 To 3

With Reg1
Select Case i
Case 1
.Pattern(Company\s[:]+\s(\w*\s*\w*\s*\w*\s*\w*\s*\w*\s*\w*\s*\w*\s*\w*\s*\w*\s*)\n)"
.Global = False
Case 2
.Pattern = "(Class Period\s*[:]+\s*([\d-\s]*))"
.Global = False
Case 3
.Pattern = "(through+\s*([\d-\s]*))"
.Global = False
End Select

End With

If Reg1.Test(sText) Then

Set M1 = Reg1.Execute(sText)
For Each M In M1
vText = Trim(M.SubMatches(1))
vText2 = Trim(M.SubMatches(2))
vText3 = Trim(M.SubMatches(3))
Next
End If
Next i

xlSheet.Range("A" & rCount) = vText
xlSheet.Range("B" & rCount) = vText2
xlSheet.Range("C" & rCount) = vText3

xlWB.Close 1

Answer 1

该错误表明您提供的参数(索引)对于 SubMatches 集合无效，因为它超出了集合中的项目数。

还要记住，SubMatches 索引从“0”开始。我假设您故意跳过第一项，而选择集合中的第二项到第四项。

我认为您希望它每次运行 for 循环时都会将匹配项添加到集合中。事实并非如此。新匹配将取代旧匹配，因此您一次只能使用一个结果。

尝试这样的事情:

Private Sub CommandButton1_Click()
    sText = "Company: ABC Company" & vbNewLine & "Class Period: 2013-10-29 through 2014-10-22" & vbNewLine
    Set Reg1 = CreateObject("VBScript.RegExp")

    vText = "Missing"
    vText2 = "Missing"
    vText3 = "Missing"

    For i = 1 To 3

        With Reg1
            Select Case i
            Case 1
                .Pattern = "(Company)\w*[:](.*?)\n"
                .Global = False
            Case 2
                .Pattern = "(Class Period\s*[:]+\s*([\d-\s]*))"
                .Global = False
            Case 3
                .Pattern = "(through+\s*([\d-\s]*))"
                .Global = False
            End Select

        End With


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

        Next i

        xlSheet.Range("A" & rCount) = vText
        xlSheet.Range("B" & rCount) = vText2
        xlSheet.Range("C" & rCount) = vText3

        xlWB.Close 1

    End Sub

请注意，我必须更改您的公司正则表达式才能使其正常工作。你原来的那个对我不起作用。