开发者

Parse ADO Recordset to Individual Excel Sheets

I'm trying to take an ADO Recordset and then loop through it to parse individual rows to different worksheets within an Excel workboo开发者_运维知识库k. Unfortunately, as I step through my code, I get the following error: Run-time error '13': Type mismatch. This occurs when I call the sub in my code - it never actually steps into the sub. I'm wondering if I'm somehow not passing the Recordset in correctly or if it's a problem somewhere within my loop.

Regardless, here's my code - any help is greatly appreciated!

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

Here is the sub that call 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


Try changing:

Me.SplitData(rs)

to:

Me.SplitData rs

Unnecessary parentheses often cause problems in VBA.

(NB I'm assuming that the two Sub shown are in a context where Me makes sense - e.g. class module, ThisWorkbook module, worksheet module, backing a UserForm etc)

0

上一篇:

下一篇:

精彩评论

暂无评论...
验证码 换一张
取 消

最新问答

问答排行榜