Creating Disconnected Recordset Clones

[techgnome]

There have been a number of times when I foun myself needing two independent copies of the same recordset.
ADO provides a .Clone function, but it doesn't truly clone or copy the recordset. What it gives you is a second pointer to the same recordset.
They are still connected. I needed a way to not only scroll through the recordsets independant of each other, but I also needed a way to sort, filter, and update the information independant. Using .Clone wouldn't alow me to do that.
So I built a better mousetrap.

DisconnectedCloneEx will allow you to create a completely separate clone of an existing recordset. In it's simplest form, it's as simple as:

Set rstTwo = DisconnectedCloneEx(rstOne)

DisconnectedCloneEx also gives you the option of passing in a secondary recordset and have the fields (but not the data) added to the returned recordset. The fields may be prepended (Added at the front) or postpended (added at the end) to the recordset. A flag setting in the parameters determines this.


Function Code:

Private Function DisconnectedCloneEx(ByVal rstData As ADODB.Recordset, Optional ByRef FieldList As ADODB.Recordset = Nothing, Optional ByVal PostPend As Boolean = True) As ADODB.Recordset
 
Dim fld As ADODB.Field
Dim rst As ADODB.Recordset
Dim lngFldCount As Long
 
On Error GoTo errHandler
    
    'Create a recordset object
    Set rst = New ADODB.Recordset
    
    'If a Field collection was passed in and it is to be pre-pended to the recordset....
    If (Not PostPend) And Not (FieldList Is Nothing) Then
        'Copy the field definitions
        For Each fld In FieldList.Fields
            'We have to make sure the field is nullable
            If (fld.Attributes And adFldIsNullable) <> adFldIsNullable Then
                fld.Attributes = fld.Attributes + adFldIsNullable
            End If
            
            rst.Fields.Append fld.Name, fld.Type, fld.DefinedSize, fld.Attributes
            
            If fld.Precision > 0 Then
                rst.Fields(fld.Name).Precision = fld.Precision
            End If
            If fld.NumericScale > 0 Then
                rst.Fields(fld.Name).NumericScale = fld.NumericScale
            End If
        Next
    End If
    
    'Copy the field definition
    For Each fld In rstData.Fields
        rst.Fields.Append fld.Name, fld.Type, fld.DefinedSize, fld.Attributes
        If fld.Precision > 0 Then
            rst.Fields(fld.Name).Precision = fld.Precision
        End If
        If fld.NumericScale > 0 Then
            rst.Fields(fld.Name).NumericScale = fld.NumericScale
        End If
    Next
    
    'If a Field collection was passed in and it is to be post-pended to the recordset....
    If (PostPend) And Not (FieldList Is Nothing) Then
        'Copy the field definition
        For Each fld In FieldList.Fields
        
            'We have to make sure the field is nullable
            If (fld.Attributes And adFldIsNullable) <> adFldIsNullable Then
                fld.Attributes = fld.Attributes + adFldIsNullable
            End If
            
            rst.Fields.Append fld.Name, fld.Type, fld.DefinedSize, fld.Attributes
            
            If fld.Precision > 0 Then
                rst.Fields(fld.Name).Precision = fld.Precision
            End If
            If fld.NumericScale > 0 Then
                rst.Fields(fld.Name).NumericScale = fld.NumericScale
            End If
        Next
    End If
    
    'Use a client cursor
    rst.CursorLocation = adUseClient
    'Open the recordset
    rst.Open , , adOpenKeyset
    
    If Not (rstData.EOF And rstData.BOF) Then
        rstData.MoveFirst
    End If
    
    'loop through the source recordset and copy the data
    Do While Not rstData.EOF
        'Add a new records
        rst.AddNew
        'Copy the field values
        For Each fld In rstData.Fields
            rst.Fields(fld.Name).Value = rstData.Fields(fld.Name).Value
        Next
 
        'Next record
        rstData.MoveNext
    Loop
    
    'If there was data to roll through,
    If rst.RecordCount > 0 Then
        'move to the begining of the source recordset
        rst.MoveFirst
    End If
    
    'Return the clone
    Set DisconnectedCloneEx = rst
    'Release objects
    Set rst = Nothing
    Set fld = Nothing
 
    Exit Function
 
errHandler:
On Error GoTo 0
    Err.Raise Err.Number, Err.Source, Err.Description
 
End Function

---- END FUNCTION


An example of how I used this function (names changed to protect the innocent, and some guilty) :

Private Sub GetSomeInfo( PKeyID As Long)
Dim cmdSelect As ADODB.Command
Dim rstResults As ADODB.Recordset
Dim rstNewFields As ADODB.Recordset
 
    On Error GoTo errHandler
    Set cmdSelect = New ADODB.Command
    With cmdSelect
        .CommandText = "sp_SelectSomeDBInfo"
        .CommandType = adCmdStoredProc
        .CommandTimeout = TIME_OUT
        .Parameters.Append .CreateParameter("@PKeyID", adInteger, adParamInput, , 0)  'NomGroupID)
        Set .ActiveConnection = mobjDBConnection
        Set rstResults = .Execute
    End With
    
    Set rstResults.ActiveConnection = Nothing
    
    Set rstNewFields = New ADODB.Recordset
    rstNewFields.Fields.Append "Processed", adBoolean, , adFldIsNullable 
    'fields need to allow for Null, since there is not default value and we don't know what value to put here 
    
    Set mrstMyRecordset = DisconnectedCloneEx(rstResults, rstNewFields, True)
    
    Set cmdSelect = Nothing
    
    Exit Sub
errHandler:
    Set mrstMyRecordset = Nothing
 
End Sub

After my call to DisconnectedCloneEx, the recordset is returned with the Processed field attached to it. You can use it to attach more than one field too. Simply add fields to the rstNewFields recordset before passing it in.


There's still some refinements I'd like to make to this eventualy, like better field specification and default values. It may need to be wrapped up into a helper class rather than a function.

-tg

-NOTE: the attachment is a text file of this post, with the code in it.

[Parax]

I was getting bad results using this code to load a local clone of a SQL recordset into an Access form's recordset property.
The recordset was loading with data, but nothing was displaying in the access form, which was showing blank records (correct number of rows, but no data). I was able to fix it by specifying a lock type, change the following:

From:

'Use a client cursor
rst.CursorLocation = adUseClient
'Open the recordset
rst.Open , , adOpenKeyset

To:

'Use optimistic lock
rst.LockType = adLockOptimistic
'Use open keyset
rst.CursorType = adOpenKeyset
'Use a client cursor
rst.CursorLocation = adUseClient
'Open the recordset
rst.Open

Thanks for the code, it's very useful for pulling read-only data into local access clients without creating 'sleeping' processes (for every read-only recordset 'open') on SQL Server.
It's now working great

[Schmidt]

In case you don't need the "full control of an explicit loop", you could consider using this faster (and shorter) version here:

Public Function CopyRs(RsSrc As Recordset) As Recordset
Dim Stm As New ADODB.Stream, RsDst As New Recordset
    RsSrc.Save Stm, adPersistADTG
    RsDst.Open Stm
Set CopyRs = RsDst
End Function

Olaf