VBA宏上的运行时错误

Question

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

公司：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

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