Creating Disconnected Recordset Clones

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:

VB Code:

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:

VB 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) :

VB Code:

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.

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:

VB Code:

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

To:

VB Code:

'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 :thumb:

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

Code:

---

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

Quote:

---

Originally Posted by Schmidt

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

Code:

---

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

---

You can also do it with a Property Bag:

Code:

---

Public Function CopyRs(RsSrc As Recordset) As Recordset
Dim RsDst As New Recordset
    With New PropertyBag
        .WriteProperty "RsSrc", RsSrc
        Set RsDst = .ReadProperty("RsSrc")
    End With
    Set CopyRs = RsDst
End Function

---

However both the "Stream" and the "PropertBag" methods are utterly useless if you want to alter the "Fields" collection of the recordset (add new fields for example). I've been banging my head against the wall for a few hours until I came to the conclusion that the method shown by @techgnome is the only way, which is most unfortunate but it is what it is...

Quote:

---

Originally Posted by VanGoghGaming

...both the "Stream" and the "PropertBag" methods are utterly useless -
if you want to alter the "Fields" collection of the recordset

---

Since this thread is about "creating clones" (from an original Rs) -
I cannot see how "additional Fields" come into play (the Clone would not be "a Clone" anymore).

If you need additional Fields (which are not in the Table you derive your original Rs from)...
then just add these new Fields as "expression-based, named Fields" into the query which gets the original Rs -
and then make a clone from that "extended Original".

Example:
Instead of "Select * From MyTable" ...
you just use "Select *, 0 As MyExtraIntegerField, 0.0 As MyExtraFloatField From MyTable"

Olaf

Quote:

---

Originally Posted by Schmidt

then just add these new Fields as "expression-based, named Fields" into the query which gets the original Rs -
and then make a clone from that "extended Original".

---

Btw, producing "synthetic" fields this way in SQL query rarely get to become updatable in the receiving ADO.Recordset unless based off some actual (temp) table columns. Being read-only might be problematic for implementing something like "IsProcessed" flag.

cheers,
</wqw>

Hmm, I wouldn't mind some clarification here. Personally, I primarily use the DAO (and not the ADO). And I use Clone extensively.

Using the DAO, when I use Clone, I've always found them to be two completely independent recordsets. Specifically, I can independently set indexes, I can independently search them, I can independently set current record pointers for fetching and altering data, and I can independently close these recordsets. Does the ADO not do this???

Quote:

---

Originally Posted by Elroy

Hmm, I wouldn't mind some clarification here. Personally, I primarily use the DAO (and not the ADO). And I use Clone extensively.

Using the DAO, when I use Clone, I've always found them to be two completely independent recordsets. Specifically, I can independently set indexes, I can independently search them, I can independently set current record pointers for fetching and altering data, and I can independently close these recordsets. Does the ADO not do this???

---

Can you independently modify first row in one recordset so the cloned recordset does not "see" these changes i.e. both recordsets have separatge sets of the same data?

Doubt it as DAO does not support client-side recordsets like ADO does with its Client Cursor Engine.

cheers,
</wqw>

Quote:

---

Originally Posted by wqweto

Can you independently modify first row in one recordset so the cloned recordset does not "see" these changes i.e. both recordsets have separatge sets of the same data?

---

Oh gosh, no, I can't do that. I know there are buffers and such, but I always think of a recordset as pointing directly to the database "on disk". Two recordsets just gives me two different ways to search, read, & modify that same set of data. Having two (or three, counting the one on disk) sets of data would be quite confusing to me. And, if I ever wanted to do that, I'd read the data into memory somehow (possibly an array of UDTs, or array of classes). I suppose that's what this thread is (sort of) about.

The original post is about "disconnected" recordsets, there is no database behind them, no "SELECT" statement. It also shows the ability to enhance the cloned recordset by adding more fields either at the beginning or at the end. This capability does come in handy when you want an easy way to manipulate some data in your application (mostly in memory, although you can also persist it to a file).

Quote:

---

Originally Posted by VanGoghGaming

The original post is about "disconnected" recordsets, there is no database behind them, no "SELECT" statement. It also shows the ability to enhance the cloned recordset by adding more fields either at the beginning or at the end. This capability does come in handy when you want an easy way to manipulate some data in your application (mostly in memory, although you can also persist it to a file).

---

Yeah, I've got it now. I suppose my primary experience with "memory" recordsets is LaVolpe's project scanner. He uses them extensively (almost exclusively for arrays) in that thing. I've just never found the need, but it is an interesting idea.

Quote:

---

Originally Posted by VanGoghGaming

The original post is about "disconnected" recordsets,

---

No, it is primary about (deep) "Clones of" (disconnected) Rs.

Quote:

---

Originally Posted by VanGoghGaming

...there is no database behind them, no "SELECT" statement.

---

Also wrong... in his example, the original Rs (which is later on "cloned") is derived from a DB (via StoredProcedure).

Quote:

---

Originally Posted by VanGoghGaming

It also shows the ability to enhance the cloned recordset by adding more fields either at the beginning or at the end.

---

Sure, the original routine allows that - but there's:
1) a faster method to make an "1:1-Clone"
2) a faster method to add additional Fields (which even allows to "avoid clientside cloning" in the first place)

@wqweto
To make such "Extra-Fields" updateable at the clientside,
a simple "ExpressionField-SubSelect" at the serverside (using the original TableName, not a temp-table) is sufficient
(at least for JET - but I assume a variant of the same will work also for SQL-Server).

Jet-Example (for adding an updateable [ProcessedState]-Field into the FieldList of a "full Select"):

Code:

---

Option Explicit
 
Private Sub Form_Load()
  Dim Cnn As ADODB.Connection, Rs As New ADODB.Recordset
  Set Cnn = CreateNewJetDB(Environ("temp") & "\test.mdb", True)
      Cnn.Execute "Create Table T(ID AutoIncrement, Name Text)"
      Cnn.Execute "Insert Into  T(Name) Values('Name 1')"
 
  Const SQL = "Select (Select Top 1 0 From T) As ProcessedState, * From T"
  Rs.Open SQL, Cnn, adOpenStatic, adLockBatchOptimistic
  Set Rs.ActiveConnection = Nothing 'disconnect the Rs from the DB
 
  Debug.Print Rs.RecordCount, Rs.Fields.Count, Rs!ProcessedState
  Rs!ProcessedState = 1 'change the value of the "extra-field"
  Debug.Print Rs.RecordCount, Rs.Fields.Count, Rs!ProcessedState
End Sub

Function CreateNewJetDB(DBFile As String, Optional ByVal DeleteExisting As Boolean) As ADODB.Connection
    Const JetPrefix = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="
    On Error Resume Next
      If DeleteExisting Then Kill DBFile
      Set CreateNewJetDB = CreateObject("ADOX.Catalog").Create(JetPrefix & DBFile)
    On Error GoTo 0
    CreateNewJetDB.CursorLocation = adUseClient
End Function

---

Olaf

It doesn't work with SQL Server though

Code:

---

Option Explicit
 
Private Sub Form_Load()
  Dim Cnn As ADODB.Connection, Rs As New ADODB.Recordset
  Set Cnn = OpenMssqlConn("UCSDB")
      Cnn.Execute "Create Table #T(ID INT IDENTITY(1,1), Name VARCHAR(MAX))"
      Cnn.Execute "Insert Into  #T(Name) Values('Name 1')"
 
  Const SQL = "Select (Select Top 1 0 From #T) As ProcessedState, * From #T"
  Rs.Open SQL, Cnn, adOpenStatic, adLockBatchOptimistic
  Set Rs.ActiveConnection = Nothing 'disconnect the Rs from the DB
 
  Debug.Print Rs.RecordCount, Rs.Fields.Count, Rs!ProcessedState

  Rs!ProcessedState = 1    '<-- Multiple-step operation generated errors. Check each status value.

  Debug.Print Rs.RecordCount, Rs.Fields.Count, Rs!ProcessedState
End Sub

Function OpenMssqlConn(ServerName As String) As ADODB.Connection
    Const MssqlPrefix = "Provider=SQLOLEDB;Integrated Security=SSPI;Data Source="
    Set OpenMssqlConn = New ADODB.Connection
    OpenMssqlConn.Open MssqlPrefix & ServerName
    OpenMssqlConn.CursorLocation = adUseClient
End Function

---

Bombs with Multiple-step operation generated errors. Check each status value. because the "extra-field" is read-only.

cheers,
</wqw>

Quote:

---

Originally Posted by wqweto

It doesn't work with SQL Server though

---

Didn't expect it to work "out of the box" also for TSQL - but there's always "a way" ;) ...

The version below will work with MS-SQLServer -
but also with JET-DBs (if you remove all "#"-temp-table prefixes from any SQL-statements).

The temporary #Defs-Table could be created as a permanent Table "with a single record in it",
to make its usage easier.

Code:

---

Private Sub Form_Load()
  Dim Cnn As ADODB.Connection, Rs As New ADODB.Recordset
  Set Cnn = OpenMssqlConn("TestDB")
      'the following table could also be made "permanent" (with exactly one single Default-Values-Record in it)
      Cnn.Execute "Create Table #Defs(IntFld Int, DblFld Float, TxtFld Text, DatFld DateTime)"
      Cnn.Execute "Insert Into  #Defs Values(0, 0.0, '', Null)"
 
      Cnn.Execute "Create Table #T(ID INT IDENTITY(1,1), Name VARCHAR(MAX))"
      Cnn.Execute "Insert Into  #T(Name) Values('Name 1')"
 
  'define the Base-Select normally
  Const SQL = "Select * From #T"
  'define 3 updateable ExtraFields via Cross-Join-Syntax (to be able to simply append it to the BaseSQL)
  Const Ex = ",(Select IntFLD As ProcessedState, TxtFld As ProcessedBy, DatFld As ProcessedAt From #Defs) Ex"
 
  Rs.Open SQL & Ex, Cnn, adOpenStatic, adLockBatchOptimistic
  Set Rs.ActiveConnection = Nothing 'disconnect the Rs from the DB
 
  Debug.Print Rs.RecordCount, Rs.Fields.Count, Rs!ProcessedState, Rs!ProcessedBy, Rs!ProcessedAt
 
    Rs!ProcessedState = 1
    Rs!ProcessedBy = Environ("UserName")
    Rs!ProcessedAt = Now
 
  Debug.Print Rs.RecordCount, Rs.Fields.Count, Rs!ProcessedState, Rs!ProcessedBy, Rs!ProcessedAt
End Sub

---

Olaf

Yes, you need BASETABLENAME and BASECOLUMNNAME attributes set on the ADODB.Field to a (temp) table for it to be updatable i.e. it's not as trivial as SELECT 0 AS IsProcessed, you have to go trough hoops and rings to achieve this in SQL Server.

cheers,
</wqw>

Quote:

---

Originally Posted by wqweto

...you have to go trough hoops and rings to achieve this in SQL Server.

---

With the solution as it is currently, the "hoops-jumping" is pretty much reduced to a single Const-Definition
(regarding Extra-Typing-efforts in User-Code - see the two blue lines which ensure the extra-fields).

Here's the Jet-DB based (full) Demo again:

Code:

---

Option Explicit
 
Private Sub Form_Load()
  Dim Cnn As ADODB.Connection, Rs As New ADODB.Recordset
  Set Cnn = CreateNewJetDB(Environ("temp") & "\test.mdb", True)
      Cnn.Execute "Create Table T(ID AutoIncrement, Name Text)"
      Cnn.Execute "Insert Into  T(Name) Values('Name 1')"
 
  'define the Base-Select normally
  Const SQL = "Select * From T"
  'define 3 updateable ExtraFields
  Const EXF = "BlnFld As ProcessedState, TxtFld As ProcessedBy, DatFld As ProcessedAt"
 
  Rs.Open AddUpdateableExtraFieldsTo(SQL, EXF), Cnn, adOpenStatic, adLockBatchOptimistic
  Set Rs.ActiveConnection = Nothing 'disconnect the Rs from the DB
 
  Debug.Print Rs.RecordCount, Rs.Fields.Count, Rs!ProcessedState, Rs!ProcessedBy, Rs!ProcessedAt
 
    Rs!ProcessedState = True
    Rs!ProcessedBy = Environ("username")
    Rs!ProcessedAt = Now
 
  Debug.Print Rs.RecordCount, Rs.Fields.Count, Rs!ProcessedState, Rs!ProcessedBy, Rs!ProcessedAt
End Sub

Function CreateNewJetDB(DBFile As String, Optional ByVal DeleteExisting As Boolean) As ADODB.Connection
    Const JetPrefix = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="
    On Error Resume Next
      If DeleteExisting Then Kill DBFile
      Set CreateNewJetDB = CreateObject("ADOX.Catalog").Create(JetPrefix & DBFile)
          CreateNewJetDB.Execute "Create Table BaseFieldDefs(TxtFld Text, IntFld Int, DblFld Float, DatFld DateTime, BlnFld Bit)"
          CreateNewJetDB.Execute "Insert Into  BaseFieldDefs Values('', 0, 0.0, Null, 0)"
    On Error GoTo 0
    CreateNewJetDB.CursorLocation = adUseClient
End Function

Function AddUpdateableExtraFieldsTo(BaseSelect As String, ExtraFields As String) As String
  AddUpdateableExtraFieldsTo = "Select * From (" & BaseSelect & ") BaseSelect, (" & _
                              "Select " & ExtraFields & " From BaseFieldDefs) ExtraFields"
End Function

---

The basically same User-Code will work also for SQLServer (using the very same AddUpdateableExtraFields-routine),
when you put the following lines at the end of your OpenMsSqlConn-Function:

Code:

---

    If OpenMssqlConn.Execute("Select Count(*) from information_schema.tables Where Table_Name='BaseFieldDefs'")(0) = 0 Then
      OpenMssqlConn.Execute "Create Table BaseFieldDefs(TxtFld nVarChar(max), IntFld Int, DblFld Float, DatFld DateTime, BlnFld Bit)"
      OpenMssqlConn.Execute "Insert Into  BaseFieldDefs Values('', 0, 0.0, Null, 0)"
    End If

---

Olaf

Quote:

---

Originally Posted by Schmidt

With the solution as it is currently, the "hoops-jumping" is pretty much reduced to a single Const-Definition

---

No, this doesn't work -- produces invalid syntax.

And you have several more lines to create the BaseFieldDefs table, so it doesn't count as a single-line solution :-)))

I told you it's all hoops and rings all the way down to the bottom of the circus :-)))

cheers,
</wqw>

Quote:

---

Originally Posted by wqweto

No, this doesn't work -- produces invalid syntax.

---

Now, if you only told me where exactly (or what nasty "Base-SQL" you fed it)... ;)

Quote:

---

Originally Posted by wqweto

And you have several more lines to create the BaseFieldDefs table, so it doesn't count as a single-line solution :-)))

---

Oh come on... about 5 lines of VB-code + much better performance
vs. the 100 lines in the original posting?

Olaf