HOWTO: Use UDT to Return State Info for Out-of-Process RecordID: Q230114
|
Not all state information is marshalled for an out-of-process ADO Recordset. This is done for performance reasons. For details, please refer to the following article in the Microsoft Knowledge Base:
Q185423 PRB: Most ADO Recordset Properties Are Not MarshalledThis article demonstrates how to return missing/non-marshalled state information using a User Defined Datatype (UDT).
The following code demonstrates using a UDT to pass an ADO.Recordset out of process with non-marshaled state information. Note: This sample is dependent on the SQL Server 'Pubs' database and 'Employee' table.
Option Explicit
Private strSQL As String
Private strConnect As String
Private ADOCn As ADODB.Connection
Type adoUDTRs
strSource As String
intState As Integer
udtRs As ADODB.Recordset
End Type
Public Function GetRs() As adoUDTRs
If Not ADOCn Is Nothing Then
Else
Err.Raise vbObjectError + 98, "GetRs", "No valid Connection"
End If
Dim adoRs As ADODB.Recordset
Dim objUDTRs As adoUDTRs
Set adoRs = New ADODB.Recordset
With adoRs
.CursorLocation = adUseClient
.ActiveConnection = ADOCn
.CursorType = adOpenStatic
.LockType = adLockBatchOptimistic
.Open strSQL
End With
'disConnect the Recordset.
Set adoRs.ActiveConnection = Nothing
With objUDTRs
.strSource = adoRs.Source
.intState = adoRs.State
Set .udtRs = adoRs
End With
GetRs = objUDTRs
Set adoRs = Nothing
End Function
Private Property Get ConnectStr() As String
ConnectStr = strConnect
End Property
Private Property Let ConnectStr(strCn As String)
strConnect = strCn
End Property
Public Property Get SQL() As String
SQL = strSQL
End Property
Public Property Let SQL(nSQL As String)
strSQL = nSQL
End Property
Public Sub UpdateRs(ByVal ClientRs As ADODB.Recordset)
Dim adoRs As New ADODB.Recordset
If Not ADOCn Is Nothing Then
Else
Err.Raise vbObjectError + 99, "UpdateRs", "No valid Connection"
End If
adoRs.ActiveConnection = strConnect
adoRs.Open ClientRs
adoRs.UpdateBatch
End Sub
Public Sub ADOConnect(strConnect As String, Optional CmdTimeOut As Integer = 20)
Set ADOCn = New ADODB.Connection
With ADOCn
.ConnectionString = strConnect
.CursorLocation = adUseClient
.CommandTimeout = CmdTimeOut
.Open
End With
ConnectStr = ADOCn
End Sub
Const strConnect = "Driver={SQL Server};Server=<myServer>;Database=Pubs;Uid=<myUserID>;Pwd=<myPassword>"
Private Sub Command1_Click()
On Error GoTo ErrorHandler
Dim objAdoRs As adoUDTRs
Dim objAdoData As New adoProcRs
Dim strInsertID As String
strInsertID = Text1.Text
With objAdoData
.SQL = "SELECT * FROM Employee WHERE Emp_ID = '" & strInsertID & "'"
.ADOConnect strConnect, 20 'Establish connection.
End With
'Return the Resultset from Data Object.
objAdoRs = objAdoData.GetRs
'values of state info in UDT.
Debug.Print objAdoRs.intState
Debug.Print objAdoRs.strSource
'state info in Recordset.
Debug.Print objAdoRs.udtRs.State 'this persists out of proc.
Debug.Print objAdoRs.udtRs.Source 'this does not.
'modify a value and send back object for update.
objAdoRs.udtRs(1).Value = "YYYZZZ"
objAdoData.UpdateRs objAdoRs.udtRs
MsgBox "Data Changed", vbOKOnly, "Data Object"
Exit Sub
ErrorHandler:
MsgBox "Change Failed:" & vbCrLf & Err.Number & vbCrLf & Err.Description, vbOKOnly, "Data Object"
Exit Sub
End Sub
'Dim objAdoRs As adoUDTRs
Dim objAdoRs As Variant
'Dim objAdoData As New adoProcRs
Dim objAdoData As Object
Dim strInsertID As String
strInsertID = Text1.Text
Set objAdoData = CreateObject("adoProc.adoProcRs")
With objAdoData
.SQL = "SELECT * FROM Employee WHERE Emp_ID = '" & strInsertID & "'"
.ADOConnect strConnect, 20 'Establish connection.
End With
For more information, please see the following article in the Microsoft Knowledge Base:
Q185423 PRB: Most ADO Recordset Properties Are Not Marshalled
Additional query words:
Keywords : kbADO kbDatabase kbMTS kbSQLServ kbVBp kbGrpVBDB
Version : WINDOWS:2.0,2.01,2.1,2.1 SP1,2.1 SP2,5.0,6.0
Platform : WINDOWS
Issue type : kbhowto
Last Reviewed: June 9, 1999