How To Use UDT to Return State Info for Out-of-Process Record (230114)

MORE INFORMATION

1. Create an ActiveX EXE project (this is the Server). Under the Project menu, choose References and add a reference to the Microsoft ActiveX Data Object Library. Paste the following code in the General Declarations section:

   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
   					

2. Change the name of the project to 'adoProc' and the name of the class to 'adoProcRs.'
3. Run the ActiveX EXE project (Server). Click to accept Wait for Components.
4. In a second instance of Visual Basic, create a Standard EXE project (this is the Client). Under the Project menu, choose References and add a reference to the adoProc component. Paste the following code in the General Declarations section:

   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
   					

5. Change the Connect string information as needed for your SQL Server.
6. Add a TextBox to the Form and set the Text property = TPO55093M.
7. Add a Command button to the Form.
8. Run the Standard EXE project (Client) and click the Command button. Note the output in the Immediate window that indicates which state information was returned from the UDT and the ADO.Recordset.
   
   This sample also works for an MTS package or COM+ application, but you will want to modify it to use CreateObject instead of the New keyword. Also, if you need to use late binding for this sample, for instance ASP, then simply change the Client code as follows:

       '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