View Single Post
  #3   Report Post  
Posted to microsoft.public.excel.programming
Mike Carlson Mike Carlson is offline
external usenet poster
 
Posts: 3
Default Operation Is Not Allowed When The Object Is Closed

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.