Operation Is Not Allowed When The Object Is Closed

[Mike Carlson]

I am getting a "Operation is not allowed when the object is closed" error
message when I try to run the following code. The stored procedure I am
calling works just fine when I execute it from SA and I can see the user I
am specifying in my connection string is actually connected to the SQL
Server but for the life of me I cant figure out why I am getting that error.
It errors out when it is opening the recordset. I am using Excel 2002.

Any help is appreciated.

Option Explicit
Dim MyConn As ADODB.Connection

Sub OpenConnection()
Set MyConn = New ADODB.Connection
MyConn.Open "Provider=SQLOLEDB; Data Source=server.domain.com; Initial
Catalog=dbTest; User ID=usrTest; Password=test; Network Library=dbmssocn;"
End Sub

Function GetRecordSet(ByVal strSQL)
On Error Resume Next

Dim Rs As ADODB.Recordset
Dim arrRs As Variant
Set Rs = New ADODB.Recordset

Rs.Open strSQL, MyConn, adOpenStatic, adLockReadOnly

If Not Rs.EOF Then
arrRs = Rs.GetRows()
End If

Rs.Close
Set Rs = Nothing

If Err.Number > 0 Then
MsgBox Err.Source & " " & Err.Description & " " & Err.Number
Exit Function
End If

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

Private 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", "Net
Change Start Date")
' strNetChangeEnd = InputBox("Enter NetChange End Date", "Net Change End
Date")
' strMonthSpecifiedStart = InputBox("Enter Month Begin Date", "Month
Begin Date")
' strMonthSpecifiedEnd = InputBox("Enter Month End Date", "Month End
Date")

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

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

 

[Wei-Dong Xu [MSFT]]

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.

 

[Mike Carlson]

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

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

 

[Mike Carlson]

I figured it out. I was not setting the timeout property of the connection
object. It was timing out. I set it to infinite and it is working fine.

--Mike

 

[Wei-Dong Xu [MSFT]]

Hi Mike,

Thank you for replying and your solution to this issue!

You are very welcome!

Please feel free to let me know if you have any questions.

Thank you once more 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.