将ADO Recordset解析为单个Excel表格

时间:2011-06-09 20:42:37

标签: excel vba ado

我正在尝试使用ADO Recordset,然后遍历它以将各个行解析为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的子<:p>

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

1 个答案:

答案 0 :(得分:4)

尝试更改:

Me.SplitData(rs)

为:

Me.SplitData rs

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

(NB我假设所显示的两个Sub位于Me有意义的上下文中 - 例如类模块,ThisWorkbook模块,工作表模块,支持{{1等等)