by Syrob (3 Submissions)
Category: Databases/Data Access/DAO/ADO
Compatability: Visual Basic 3.0
Difficulty: Intermediate
Date Added: Wed 3rd February 2021
Rating: 
(5 Votes)
This code demonstrates
how to use a connectionless recordset.
Assumes
The program uses ADO.
VBcodersOption Explicit
'an object variable
Dim RsD As ADODB.Recordset
'a boolean variable
Dim f As Boolean
Public Function GetNames() As String()
'an object variable
Dim rs As ADODB.Recordset
'an object variable to hold a reference
'to an instance of the clsDB class
Dim objDB As clsDB
'a dynamic array
Dim a() As String
'an integer variable
Dim i As Integer
'a string variable
Dim l As String
'get a reference to the objDB object
Set objDB = New clsDB
'execute GetData function on the objDB
'object to get a reference to the recordset
Set rs = objDB.GetData
'extract the data from the recordset
'and applay to them a business rule
Do Until rs.EOF
'build a text
l = rs!titleofcourtesy
l = l & Left(Trim(rs!FirstName), 1) & "."
l = l & rs!lastname
'resize the array
ReDim Preserve a(i)
'populate the array
a(i) = l
'set a size of the array
i = i + 1
'call MakeRs method
MakeRs rs!Notes, rs!employeeid
'move to the next record
rs.MoveNext
Loop
'assign the array to a GetNames function
GetNames = a
End Function
Private Sub MakeRs(strData As String, intID As Integer)
'if the RsD recordset does not exist
'then create the recordset
If Not f Then
Set RsD = New Recordset
With RsD
.Fields.Append "ID", adInteger
.Fields.Append "Notes", adBSTR
.Open
End With
'set a flag to indicate that
'the recordset exists
f = True
End If
'dump the data into the recordset
With RsD
.AddNew
.Fields("ID") = intID
.Fields("Notes") = strData
.Update
End With
End Sub
Public Property Get Notes() As ADODB.Recordset
'assign the recordset to the property
Set Notes = RsD
End Property
Public Function SaveData(rs As ADODB.Recordset, f() As Integer) As Boolean
'an object variable
Dim objDB As clsDB
'a string variable
Dim l As String
'an integer variable
Dim i As Integer
'error handler
On Error GoTo ErrSave
'get a reference to the objDB object
Set objDB = New clsDB
'make sure that we start from the first record
rs.MoveFirst
'extract the updated data from
'the recordset and pass them
'to UpdateRecords function
Do Until rs.EOF
For i = 0 To UBound(f)
'check if the data were changed
If f(i) = rs!ID Then
l = rs!Notes
'applay a business rule
If l = "" Then
l = "Notes deleted " & Date
End If
If Not objDB.UpdateRecords(rs!ID, l) Then
'indicate a failure
SaveData = False
Exit Function
End If
End If
Next i
rs.MoveNext
Loop
'put an end to the object
Set rs = Nothing
'we are happy
SaveData = True
Exit Function
ErrSave:
'indicate a failure
SaveData = False
End Function
