VB icon

A Connectionless Recordset

Email
Submitted on: 1/23/2015 10:53:00 AM
By: Syrob (from psc cd)  
Level: Intermediate
User Rating: By 5 Users
Compatibility: VB 6.0
Views: 1292
 
     This code demonstrates how to use a connectionless recordset.
 
code:
Can't Copy and Paste this?
Click here for a copy-and-paste friendly version of this code!
				
'**************************************
' Name: A Connectionless Recordset
' Description:This code demonstrates
how to use a connectionless recordset.
' By: Syrob (from psc cd)
'
' Assumes:The program uses ADO.
'**************************************

Option 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


Other 2 submission(s) by this author

 


Report Bad Submission
Use this form to tell us if this entry should be deleted (i.e contains no code, is a virus, etc.).
This submission should be removed because:

Your Vote

What do you think of this code (in the Intermediate category)?
(The code with your highest vote will win this month's coding contest!)
Excellent  Good  Average  Below Average  Poor (See voting log ...)
 

Other User Comments


 There are no comments on this submission.
 

Add Your Feedback
Your feedback will be posted below and an email sent to the author. Please remember that the author was kind enough to share this with you, so any criticisms must be stated politely, or they will be deleted. (For feedback not related to this particular code, please click here instead.)
 

To post feedback, first please login.