RecordSet

The Recordset object is used to hold a set of records from a database table.
When you first open a recordset, the currrent record pointer will point to the first record, and the BOF and EOF properties are False.
If there are no reocrds, the BOF and EOF properties are True.


Recordset objects can support two types of updating
Immediate Updating - all changes are written immediately to the database once you call the Update method
Batch Updating - the provider cache multiple changes and then send them to the database with the UpdateBatch method


Returning a RecordSet

There are in fact three ways you can create a recordset.
Another difference is the way the command is specified in the three methods:
Both the execute methods are intended for (but not limited to) executing commands that do not return data.
On the other hand, the Open method allows you to specify the CursorType (strategy and object used to access the data); and LockType (specify the degree of isolation from other users, and whether the cursor should support updates in immediate or batch modes).


Connection.Execute(CommandText, RecordsAffected, Options)
The Connection.Execute method uses the connection embodied by the Connection object itself. In the Connection.Execute method, the command is a string.
CommandText -
RecordsAffected -
Options -


Command.Execute(RecordsAffected, Parameters, Options)
The Command.Execute method allows you to use parameterized commands. The Command.Execute method uses the Connection object set in its ActiveConnection property. In the Command.Execute method, the command isn't visible, it's specified in the Command.CommandText property.
Furthermore, the command can contain parameter symbols ('?') which will be replaced by the corresponding parameter in the Parameters VARIANT array argument.
RecordsAffected -
Parameters -
Options -


Recordset.Open [Source] [, Connection] [, CursorType] [, LockType] [, Options]
The Recordset.Open method specifies either a connect string or Connection object operand, or uses the Connection object set in its ActiveConnection property. In the Recordset.Open method, the command is the Source argument, which can be a string or a Command object.
Although you could invoke a short-cut method using Recordset.Open where the activeconnection could be a literal string or a connection object representing an open connection


Source - tells it what data it should retrieve. The Source could be any of the following: Command object - Name of a view / query; String variable - Stored procedure / function; Name of a table - Valid SQL stamement
Connection - Assign an existing connection object or a connection string. If you assign a connection string then the Recordset Object will create a Connection for you automatically
CusorType - indicates the type of cursor used when opening the recordset
LockType - indicates the type of the lock in effect for editing
Options - used to tell the provider how to interpret and execute the contents of the source argument


You can open three types of recordset - Snapshot, Dynaset, Table


Recordset Properties and Methods

NameTypeDescription
Absolute  
AbsolutePageProperty 
AbsolutePositionProperty 
AddNewMethodCreates a new record
BOFPropertyreturns True if the current record position is before the first record, otherwise False
BookmarkPropertySets or returns a boomark. Lets the user flag a record in a recordset and return to it later
CacheSizePropertylets you cache a given number of records to improve performance
CancelBatchMethodCancels a batch update
CancelUpdateMethodCancels changes made to a record
CloneMethodcreates copies of a reocrdset allowing the user position the record pointer of each copy idenpendently. Usually done by creating a small array of recordsets
CompareBookmarksMethodCompares two bookmarks
CursorLocationPropertySets or returns the location of the cursor
CursorTypePropertySets or returns the cursor type of the recordset object
Data MemberPropertySets or returns the name of the data member that will be retieved from the object referenced by the DataSource property
DataSourcePropertySpecifies an onject containing data to be represented as a Recordset object
Delete  
EditModePropertyReturns the editing status of the current record
EOFPropertyReturns True if the current record position is after the last record, otehrwise False
Exceute  
Fields  
FilterPropertyallows you to restrict the records viewed in a reocrdset
GetRowsMethodRetrieve a specified number of rows from a recordset and returns a Variant array. The first dimension contains columns the second dimension contains rows.
GetStringMethodReturns a recordset as a string
IndexPropertySets or returns the name of the current index for a recordset object
LockTypePropertySets or returns a value that specifies the type of locking when editing a recordset object
MarshallOptionsPropertyspecifies what rows are sent back to the server (whether all rows or just modified rows)
MaxRecordsPropertyspecifies the maximum of records returned before opening the recordset
MoveMethodwill move the current record position any number of places (either positive or negative) . This requires of a data type of a type long
MoveFirstMethodThe order of records depends on the current index, or, if there is no index, on the order of entry. This method functions with all cursor types. Its use with forward-only cursors can force a reexecution of the command that generated the recordset.
MoveLastMethodEstablishes the last record in a recordset as the current record position. It requires a cursor type that supports backward movement or at least movement based on bookmarks. Using the method with a forward-only cursor generates a run-time error.
MoveNextMethodRelocates the current record position one record forward (in the direction of the recordset's final record). If the current record position is the last record, the recordset's EOF property is set to True. If this method is called when the recordset's EOF property is already True, a run-time error results.
MovePreviousMethodSends the current record position one record backward. If the current record position is the first record, the recordset's BOF property is set to True. If this method is called when the recordset's BOF property is already True, a run-time error results. This method also generates a run-time error if you use it with a forward-only cursor type.
NextRecordSetMethodLets you view the data in a recordset that uses a compound command statement made up of a series of SELECT statements
OpenMethodOpens a database element giving you access to records in a table, the results of a query or to a previously saved recordset
PageCountPropertyReturns the number of pages with data
PageSizePropertySets or returns the maximum number of records allowed on a single page
RecordCountPropertyRetruns the number of records
RequeryMethodto retrieve current data in a recordset
ResyncMethodRefreshes data in a static variable
SaveMethodSaves a recordset to a file or a stream object
SeekMethodSearches the index of a recordset to find a record that matches the specified values
SortPropertySets or returns the field name(s) to sort on
State  
StatusPropertyReturns the status of the current record with regard to batch updates or other bulk operations
StayInSynPropertySets or returns whether the reference to the child records will change when the parent record position changes
Update replaces the original data with the buffered data inb the Recordset
UpdateBatchMethodSaves all changes when working in batch update maode

The row you can examine and manipulate at any given time is the current row, and your location in the Recordset is the current row position. Every time you move to another row, that row becomes the new current row.
Several methods explicitly move or "navigate" through the Recordset (the Move methods). Some methods (the Find method) do so as a side effect of their operation. In addition, setting certain properties (Bookmark property) can also change your row position.


Fields Collection

A Recordset has a Fields collection, which is the set of Field objects that represent each field (or column).
Assign or retrieve the data for a field from the Field object's Value property.
As an option, you can access field data in bulk (the GetRows and Update methods).
This contains all the information about the fields returned including the column names of each field in the recordset.
This collection is most commonly used proir to accessing the actual contents of the recordset

Public Sub RecordsetToRange(ByVal sColFirst As String, _ 
                            ByVal lRowFirst As Long, _
                   Optional ByVal bIncludeFields As Boolean = True)
Dim lrownumber
Dim icolumnnumber As Integer
Dim lrecordcounter As Long
Dim ifieldnumber As Long

   lrownumber = lRowFirst
   If dbADORecordSet.State = ADODB.adStateOpen Then
      icolumnnumber = Col_Number(sColFirst)
      If bIncludeFields = True Then
         For ifieldnumber = 1 To dbADORecordSet.Fields.Count
            ActiveSheet.Range(Col_Letter(icolumnnumber) & lrownumber).Value = _
                              CStr(dbADORecordSet.Fields(ifieldnumber - 1).Name)
            icolumnnumber = icolumnnumber + 1
         Next ifieldnumber
         lrownumber = lrownumber + 1
      End If
      While Not dbADORecordSet.EOF
         icolumnnumber = Col_Number(sColFirst)
         For ifieldnumber = 1 To dbADORecordSet.Fields.Count
            ActiveSheet.Range(Col_Letter(icolumnnumber) & lrownumber).Value = _
                              CStr(dbADORecordSet.Fields(ifieldnumber - 1).Value)
            icolumnnumber = icolumnnumber + 1
         Next ifieldnumber
         dbADORecordSet.MoveNext
         lrownumber = lrownumber + 1
      Wend
   End If
   Set dbADORecordSet = Nothing
End Sub

Dim arRecords As Variant
arRecords = objRecordset.GetRows()
'This array will be zero based and will also include the column names ???

Navigation

Use the Move methods to navigate from the beginning of the sorted, filtered recordset to the end


CursorLocation 
  
CursorTypeadOpenDynamic - Lets you see changes to rows by others and any added rows
 adOpenStatic - A read only snapshot, you can't see any changes made by others
 adOpenUnspecified
 adOpenForwardOnly (default) - A read only snapshot, lets you move through the record only once. Use the .movenext method to access successive rows
 adOpenKeyset - Lets you see changes to rows made by others, but you will not see new rows added by others
Lock TypeadLockPessimistic - Locks rows as oon as you use the Edit method (which places the row in editable state)
 adLockOptimistic
 adLockReadOnly (default) - No locks, cursor is read only
 adLockUnspecified
 adLockBatchOptimistic
 adAsyncConnect
OptionsadCmdUnknown
 adCmdText - source is an SQL statement
 adCmdTable (default) - source is a table name, basically produces a small piece of SQL code to Select the whole table (analogous to a DAO dynaset record)
 adCmdTableDirect - source is a table name (analygous to a DAO dbpentable recordset
 adCmdStoredProc - source is a stored procedure or function (analogous to a DAO dynaset on a sorted query)
StateadStateClosed
 adStateExecuting
 adStateFetching
 adStateOpen
FilteradFilterConflictingRecords
 adFilterNone

The row you can examine and manipulate at any given time is the current row, and your location in the Recordset is the current row position. Every time you move to another row, that row becomes the new current row.
Several methods explicitly move or "navigate" through the Recordset (the Move methods). Some methods (the Find method) do so as a side effect of their operation. In addition, setting certain properties (Bookmark property) can also change your row position.


Filter Property

The Filter property can be applied to control rows you can access (that is, which rows are "visible" to you). The Sort property controls the order in which you navigate the rows of the Recordset.
You can set multiple filters and the records exposed by the filtered recordset will be only those records that meet all the conditions.
To remove a filter from a recordset, set the filter property to adFilterNone


When you specify a parameter you must append it to the parameter collection

Public dbADORecordset as ADODB.recordset 
Public dbADORecordsetFiltered as ADODB.recordset
Public sSQLQuery as String
Public sFilterStr as String

Set dbADORecordSet = New ADODB.recordset
dbADORecordset.Cursortype = ADODB.adOpenStatic
dbADORecordset.LockType = ADODB.adLockReadOnly

sSQLQuery = "SELECT * FROM PROCEDURES WHERE procedure_name LIKE 'p%'"
dbADORecordset.Open sSQLQuery, sConnectionStr, , , adCmdText

sFilterStr = "procedure_name = 'parse_string'"
dbRecordsetFiltered = dbADORecordset.Filter = sFilterStr

Set dbADORecordset = Nothing
Set dbADORecordsetFiltered = Nothing

Properties Collection

This contains any extended provider specific properties.


Example - Recordset.Open, with an invisible connection

recordset.Open Source, ActiveConnection, CursorType, LockType, Options The Recordset.Open method specifies either a connect string or Connection object operand, or uses the Connection object set in its ActiveConnection property. In the Recordset.Open method, the command is the Source argument, which can be a string or a Command object.

Set objADORecordSet = New ADODB.Recordset 
sConnectionString = "PROVIDER = "SQLOLEDB"
                                   SERVER =
                                   DATABASE =
                                   UID =
                                   PWD =
sSQLQuery = "SELECT * FROM Books"
objADORecordSet.Open sSQLQuery, sConnectionString

Note: When a recordset is open by passing a connection string instead of a connection object an invisible connection object is created before the recordset is open. Every time this code is called another connection to the data source is created which is probably unnecessary. Below is the Vb code to do the same although using a connection object


When a recordset is open by passing a connection string instead of a connection object an invisible connection object is created before the recordset is open. Every time this code is called another connection to the data source is created


You should always explicitly create and re-use a connection object. Note that the same rules apply to the Enter, RecordSet and Field objects


Example - Recordset.Open, with a visible connection

Set objADOConnection = New ADODB.Connection 
sConnectionStr = "PROVIDER=MSDASQL;" & _
                 "DRIVER={Oracle ODBC Driver};" & _
                 "DBQ=" & sConnectingString & ";" & _
                 "UID=" & sUserId & ";" & _
                 "PWD=" & sPassWord & ";"

   objADOConnection.CursorLocation = ADODB.adUseClient
   objADOConnection.Open sConnectionStr, _
                         sUserId, _
                         sPassWord, _
                         adConnectUnspecified
Set objADORecordSet = New ADODB.Recordset

sSQLQuery = "SELECT * FROM Books"
objADORecordSet.Open sSQLQuery , objADOConnection

If Not(objADORecordSet Is Nothing) Then
   objADORecordSet.Close()
   Set objADORecordSet = Nothing
End If
Set objADOConnect = Nothing

EOF - end of file / recordset
BOF - beginning of file / recordset


GetRows Method

GetRows(rows, start, fields)
rows - Optional - A GetRowsOptionEnum value that specifies the number of records to retrieve. Default is adGetRowsRest
start - Optional - What record to start on, a record number of a BookmarkEnum value.
fields - Optional - If you want to specify only the fields that the GetRows call will return. It is possible to pass a single fieldname/number or an array of field names/numbers.
This method returns a 0-based array wherer the first dimension is the columns and the second dimension is the rows.
This array will have to be transposed if the data is to be displayed correctly in Excel.

arArray = objRecordset.GetRows() 
lNoOfRows = Ubound(arArray,2) + 1
'(plus1 since the array is zero based)

This array can then be transposed so that the rows are the first dimension before populating the range with that array.



© 2024 Better Solutions Limited. All Rights Reserved. © 2024 Better Solutions Limited TopPrevNext