I dont want to pass the recordset back to the calling function, I am
grabbing all the records into a recordset, putting them into an array with
GetRows() and then passing that array back to the calling sub. I dont want
to pass the recordset back.
--Mike
"Wei-Dong Xu [MSFT]" wrote in message
...
Hi Mike,
The recordset object has been set to nothing before passed to the
function. If you want to pass the recordset from the internal function to
outer,
you'd better clone the recordset and set it to the function for returning.
After that, you can close the "RS". Based on my test to local northwind
database, it runs very smoothly after my little modification. Please
check the modified codes:
'//Code start
'------------------------------------------------
Option Explicit
Dim MyConn As ADODB.Connection
Sub OpenConnection()
Set MyConn = New ADODB.Connection
MyConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\Documents
and Settings\v-wdxu\My Documents\Northwind.mdb;Persist
Security Info=False"
End Sub
Function GetRecordSet(ByVal strSQL) As ADODB.Recordset
On Error Resume Next
Dim Rs As ADODB.Recordset
Dim arrRs As Variant
Set Rs = New ADODB.Recordset
Dim objRD As ADODB.Recordset
Rs.Open strSQL, MyConn, adOpenStatic, adLockReadOnly
If Not Rs.EOF Then
arrRs = Rs.GetRows()
End If
'clone one recordset for return. If you close the orginal recordset,
you can't return it to outer function
Set GetRecordSet = Rs.Clone(adLockReadOnly)
Rs.Close
Set Rs = Nothing
If Err.Number 0 Then
MsgBox Err.Source & " " & Err.Description & " " & Err.Number
Exit Function
End If
'If RS is closed, arrRS will contain nothing
'GetRecordSet = arrRs
End Function
Sub ReleaseObj(ByRef obj, ByVal shouldClose, ByVal shouldSetToNothing)
On Error Resume Next
If shouldClose Then obj.Close
If shouldSetToNothing Then Set obj = Nothing
Err.Clear
End Sub 'ReleaseObj
Sub Workbook_Open()
Dim strSQL As String
Dim arrRecords As Variant
Dim X As Long
Dim strStart As String
Dim strEnd As String
Dim strNetChangeStart As String
Dim strNetChangeEnd As String
Dim strMonthSpecifiedStart As String
Dim strMonthSpecifiedEnd As String
' strStart = InputBox("Enter Begin Date", "Begin Date")
' strEnd = InputBox("Enter End Date", "End Date")
' strNetChangeStart = InputBox("Enter The Net Change Start Date",
"NetChange Start Date")
' strNetChangeEnd = InputBox("Enter NetChange End Date", "Net Change
EndDate ")"
' strMonthSpecifiedStart = InputBox("Enter Month Begin Date",
"MonthBegin Date")
' strMonthSpecifiedEnd = InputBox("Enter Month End Date", "Month
EndDate ")"
strStart = "12/31/2002"
strEnd = "08/29/2003"
strNetChangeStart = "01/01/2003"
strNetChangeEnd = "07/25/2003"
strMonthSpecifiedStart = "07/26/2003"
strMonthSpecifiedEnd = "08/29/2003"
' strSQL = "exec sp_GLData '" & strStart & "','" & strEnd & "','" & _
'strNetChangeStart & "','" & strNetChangeEnd & "','" &
strMonthSpecifiedStart & _
'"','" & strMonthSpecifiedEnd & "'"
'MsgBox strSQL
strSQL = "select * from Customers"
Call OpenConnection
arrRecords = GetRecordSet(strSQL)
Call ReleaseObj(MyConn, True, True)
' For X = 0 To UBound(arrRecords, 2)
' ThisWorkbook.Sheets(1).Rows(X + 1).Cells(1) = arrRecords(0, X)
' ThisWorkbook.Sheets(1).Rows(X + 1).Cells(2) = arrRecords(1, X)
' ThisWorkbook.Sheets(1).Rows(X + 1).Cells(3) = arrRecords(2, X)
' ThisWorkbook.Sheets(1).Rows(X + 1).Cells(4) = arrRecords(3, X)
' ThisWorkbook.Sheets(1).Rows(X + 1).Cells(5) = arrRecords(4, X) &
"" & arrRecords(5, X)
' Next X
End Sub
'//Code end
'--------------------------------------
Please feel free to let me know if you have any questions.
Does this answer your question? Thank you for using Microsoft NewsGroup!
Wei-Dong Xu
Microsoft Product Support Services
Get Secure! - www.microsoft.com/security
This posting is provided "AS IS" with no warranties, and confers no
rights.