将 ADO 记录集解析为单个 Excel 工作表

Question

我正在尝试获取 ADO 记录集，然后循环遍历它以将各个行解析为 Excel 工作簿中的不同工作表。不幸的是，当我单步执行代码时，出现以下错误：运行时错误“13”：类型不匹配。当我在代码中调用 sub 时会发生这种情况 - 它实际上从未进入 sub。我想知道我是否以某种方式没有正确传递 Recordset，或者它是否是我循环中某处的问题。

无论如何，这是我的代码 - 非常感谢任何帮助！

Sub SplitData(ByVal rs As ADODB.Recordset)

' Instantiate count variables for each result type
' Start at 2 to give room for Table headers on sheets
Dim NewAppsCount, BadLogCount, MatNotesCount, ZeroBalCount As Integer
NewAppsCount , BadLogCount, MatNotesCount, ZeroBalCount = 2

' Row Counter
Dim Count As Long
Count = 0

' Loop through the recordset and parse rows to appropriate worksheets
Do While Not rs.EOF
    If CStr(rs.Fields("Maturity Date")) = "" Then
        If CStr(rs.Fields("Log_Date")) = "" Then
            ' Applications that have not been properly logged
            Sheet4.Range("A" & CStr(BadLogCount)) = rs.Fields(Count).Value
            Count = Count + 1
            BadLogCount = BadLogCount + 1
        Else
            ' New Applications
            Sheet6.Range("A" & CStr(NewAppsCount)) = rs.Fields(Count).Value
            Count = Count + 1
            NewAppsCount = NewAppsCount + 1
        End If
    Else
        If Month(rs.Fields("Maturity Date")) < Month(Date) Then
            ' Maturing Notes with Zero Outstanding Balance
            Sheet7.Range("A" & CStr(ZeroBalCount)) = rs.Fields(Count).Value
            Count = Count + 1
            ZeroBalCount = ZeroBalCount + 1
        Else
            ' Maturing Notes
            Sheet8.Range("A" & CStr(MatNotesCount)) = rs.Fields(Count).Value
            Count = Count + 1
            MatNotesCount = MatNotesCount + 1
        End If
    End If
    rs.MoveNext
Loop

End Sub

这是调用 GetData 的子程序：

Sub GetData(ByVal Update As Boolean)
Dim conn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim query As String
Dim path As String
Dim prompt, result As Integer
Dim day, today As String

' ...skipping stuff not related to the issue...

    ' Set the UNC Path
    path = "\\this\is\the\path"

    ' Instantiate ADO Objects
    Set conn = New ADODB.Connection
    Set rs = New ADODB.Recordset

    ' Connect to data source
    conn.Open "Provider=Microsost.JET.OLEDB.4.0;Data Source=" & path & ";"

    ' The Query
    query = "This is a big 'ol query that I won't repost here"

    'Run the query and populate the Recordset object
    rs.CursorLocation = adUseClient
    rs.Open query, conn, adOpenStatic, adLockReadOnly

    'Parse contetns of Recordset to worksheet
    Application.ScreenUpdating = False
    Me.SplitData(rs)

    'Close the ADO Objects, set them to null, and exit sub
    rs.Close
    conn.Close
    Set rs = Nothing
    Set conn = Nothing
    Exit Sub
End Sub

Answer 1

尝试改变：

Me.SplitData(rs)

到：

Me.SplitData rs

不必要的括号通常会导致 VBA 出现问题。

（注意，我假设显示的两个 Sub 处于 Me 有意义的上下文中 - 例如类模块、ThisWorkbook 模块、工作表模块、支持 UserForm 等）