VBA 宏上的运行时错误

Question

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

公司：ABC 公司
上课时间：2013-10-29 至 2014-10-22

我已经设置了一个 For With 循环来遍历电子邮件并在 A 列中插入公司名称，在 B 列中插入第一个日期 (2013-10-29) 和另一个日期 (2014-10-22)在 C 列中。当我运行我的代码时，我收到一条错误消息：运行时错误 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

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