Article ID: 185423
Article Last Modified on 3/14/2005
' Function to return a disconnected recordset.
Public Function GetRcdSet() As Recordset
Dim con As New Connection
Dim rs1 As New Recordset, rs2 As New Recordset
Dim newValue as String
newValue = "Test Modified String"
On Error GoTo ErrHandler
con.Open "DSN=SQLServer;database=pubs", "sa"
Set rs1.ActiveConnection = con
rs1.CursorLocation = adUseClient
' Table1 is a table with the first column Varchar(255).
rs1.Open "table1", , adOpenKeyset, adLockOptimistic, adCmdTable
' Check the value of Source property - should be "Table1".
Debug.Print rs1.Source
' Disconnect recordset.
Set rs1.ActiveConnection = Nothing
Set GetRcdSet = rs1
' Modify one of the records.
rs2.Open "table1", con, adOpenDynamic, adLockOptimistic, adCmdTable
rs2.MoveFirst
rs2.Fields(0).Value = newValue
rs2.Update
rs2.Close
Set rs2 = Nothing
con.Close
Set con = Nothing
Exit Function
ErrHandler:
MsgBox Err.Description
End Function
' Function to update the changes made to the recordset and
' also returns the recordset back to the client.
Public Function Update(rs As Recordset) As Recordset
Dim con As New Connection
On Error GoTo ErrHandler
con.Open "dsn=Ram;database=pubs", "sa"
Set rs.ActiveConnection = con
rs.UpdateBatch adAffectAll
Set Update = rs
Set con = Nothing
Exit Function
ErrHandler:
MsgBox "Error in updating ErrDesc: " & Err.Description
Set Update = rs
Debug.Print "status at server is " & rs.Status
Set con = Nothing
End Function
Private Sub Command1_Click()
Dim rs As Recordset
Dim x As Object
Dim rs2 As Recordset
Set x = CreateObject("myproj.cls1")
Set rs = x.GetRcdSet
' Check the value of Source property.
' Source property is empty string here.
Debug.Print rs.Source
rs.MoveFirst
' Modify a field in a recordset.
rs.Fields(0).Value = "String modified at client"
Set rs2 = x.Update(rs)
Debug.Print "Status at client" & rs2.Status
Set rs2 = Nothing
End Sub
Keywords: kbdatabase kbprb KB185423