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)
精彩评论