Error 3704 could not open an object which is closed with an MTS compon

[DavidVel]

I am trying to develop MTS components in an n-tier environement.
I've develop a component in which I've a function which return a disconnected adodb.recordset . Sometimes when I call this function I've got the error 3704.I've test my components on two different MTS Machine . The component works perfectly on one of these machine and produce the error 3704 on the other machine ( the ways of Microsoft are often very Mysterious )
The code of the function is the following :

Public Function RetrieveDataFromSelect(ByVal strConnectionString As String, ByVal strSql As String) As Object

Dim rst As Object
Dim vntData As Variant

Dim oConn As Object
Dim ctxObject As ObjectContext

On Error GoTo Err_Management:

Set ctxObject = GetObjectContext()
If Not ctxObject Is Nothing Then
Set oConn = ctxObject.CreateInstance("ADODB.Connection&quot
Else
Set oConn = New ADODB.Connection 'CreateObject("ADODB.Connection&quot
End If
oConn.Open strConnectionString
oConn.Execute "set dateformat 'DMY'"
If Not ctxObject Is Nothing Then
Set rst = ctxObject.CreateInstance("ADODB.Recordset&quot
Else
Set rst = New ADODB.Recordset ' CreateObject("ADODB.Recordset&quot
End If
rst.LockType = 4 'adlockbatchoptimistic
rst.CursorLocation = 3 'adUseClient
rst.CursorType = 3 'adopenstatic
rst.Open strSql, oConn
Set rst.ActiveConnection = Nothing
oConn.Close
Set oConn = Nothing
Set RetrieveDataFromSelect = rst
Set rst = Nothing
If Not ctxObject Is Nothing Then
ctxObject.SetComplete
End If
Exit Function
Err_Management:
If Not rst Is Nothing Then
rst.Close
Set rst = Nothing
End If
If Not oConn Is Nothing Then
oConn.Close
Set oConn = Nothing
End If
If Not ctxObject Is Nothing Then
ctxObject.SetAbort
End If

Err.Raise 10002, "Technical error occurred in Method: RetrieveDataFromSelect Class: clsDbConnection ", "Error description :" & Err.Description & vbCrLf & "Error number : " & CStr(Err.Number) & vbCrLf & "Specific description : An error has occurred during the try to execute the query : " & strSql

End Function


The function that call this function is in another component an the code is :


Public Sub fUpdateContentRecord(ByVal ArgStrConn As String, ByVal ArgLngContentId As Long, ByVal ArgStrMnemo As String, ByVal ArgStrDesc As String, ByVal ArgStrRFC_Mnemo As String, ByVal ArgStrRFC_USER_ID As String, ByVal ArgStrDateMod As String)

Dim strSQL As String
Dim clsdbRead As Object
Dim clsDbUpdate As Object
Dim recContent As Object
Dim ctxObject As ObjectContext
Dim strDateModContentDb As String
Dim lngNumberRec As Long

On Error GoTo ErrHandler:

Set ctxObject = GetObjectContext()
'validation donnée contentID
'************************************************************
'data validation
'************************************************************
fValidateDataContentID ArgLngContentId
'validation donnée mnemo
fValidateDataRFC_Mnemo ArgStrMnemo
'validation donnée decription
fValidateDataDescription ArgStrDesc
'validation donnée rfc_mnemo
fValidateDataRFC_Mnemo ArgStrRFC_Mnemo
' 'validation donnée rfc_user id
fValidateDataUserID ArgStrRFC_USER_ID
'validation datemod
fValidateDataDateMod ArgStrDateMod
'*************************************************************
'Open data base connection
'*************************************************************
If Not ctxObject Is Nothing Then
Set clsdbRead = ctxObject.CreateInstance("DatabaseCommunicator.ClsdbRead&quot
Else
Set clsdbRead = CreateObject("DatabaseCommunicator.ClsdbRead&quot
End If
'*************************************************************
'Update content data
'*************************************************************

fRightToModifyRecordForOneUser ArgStrConn, ArgLngContentId, ArgStrRFC_USER_ID

strSQL = "SELECT Count(*) as lngNumberRec From content where id=" & CStr(ArgLngContentId)
'*********************************
' THE ERROR OCCURED HERE
'*********************************
Set recContent = clsdbRead.RetrieveDataFromSelect(ArgStrConn, strSQL)
lngNumberRec = recContent.Fields("lngNumberRec&quot
If lngNumberRec > 0 Then
recContent.Close
Set recContent = Nothing
strSQL = "SELECT convert(varchar(20),date_Mod,120) as strDateModContentDb from Content where ID=" & CStr(ArgLngContentId)
Set recContent = clsdbRead.RetrieveDataFromSelect(ArgStrConn, strSQL)
If Not IsNull(recContent.Fields("strDateModContentDb&quot) Then
strDateModContentDb = recContent.Fields("strDateModContentDb&quot
Else
strDateModContentDb = ""
End If
recContent.Close
Set recContent = Nothing
If Trim(strDateModContentDb) = Trim(ArgStrDateMod) Then
strSQL = "UPDATE CONTENT Set Mnemo = '" & ArgStrMnemo & "' ,Description = '" & ArgStrDesc & "', RFC_Mnemo = '" & ArgStrRFC_Mnemo & "' ,RFC_USER_ID = '" & ArgStrRFC_USER_ID & "' ,RFC_ACTION='UP' ,Enable=1 Where ID=" & CStr(ArgLngContentId)
Else
Err.Raise 10201, "", "The Content record with contentID= " & CStr(ArgLngContentId) & " and Mnemo= " & ArgStrMnemo & " was modified by another user on the network! Update failed .(DBdate = " & strDateModContentDb & " / Date send =" & ArgStrDateMod & &quot"
End If
Else
Err.Raise 10200, "", "It exist no record with contentID= " & CStr(ArgLngContentId)
End If
Set clsdbRead = Nothing
If Not ctxObject Is Nothing Then
Set clsDbUpdate = ctxObject.CreateInstance("DatabaseCommunicator.ClsdbUpdate&quot
Else
Set clsDbUpdate = CreateObject("DatabaseCommunicator.Clsdbupdate&quot
End If
clsDbUpdate.ExecuteSqlUpdateInsertDelete ArgStrConn, strSQL
Set clsDbUpdate = Nothing

If Not ctxObject Is Nothing Then
ctxObject.SetComplete
End If
Exit Sub
ErrHandler:
If Not recContent Is Nothing Then
recContent.Close
Set recContent = Nothing
End If
Set clsdbRead = Nothing
Set clsDbUpdate = Nothing
If Not ctxObject Is Nothing Then
ctxObject.SetAbort
End If
If Err.Source = "" Then
Err.Raise Err.Number, "Class clscontentUpdatedatas Function:fUpdateContentRecord", Err.Description
Else
Err.Raise Err.Number, Err.Source, Err.Description
End If
End Sub


Do anybody knows how I can solve this problem ?
Is the problem due to the MDAC ?