# VBForums CodeBank > CodeBank - Visual Basic 6 and earlier >  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:

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.FieldDim rst As ADODB.RecordsetDim 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.CommandDim rstResults As ADODB.RecordsetDim 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 SuberrHandler:    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:

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:

----------


## 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

----------


## VanGoghGaming

> 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
> ...


You can also do it with a Property Bag:



```
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...

----------


## Schmidt

> ...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

----------


## wqweto

> 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>

----------


## 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???

----------


## wqweto

> 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>

----------


## Elroy

> 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.

----------


## 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).

----------


## Elroy

> 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.

----------


## Schmidt

> The original post is about "disconnected" recordsets,


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




> ...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).




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


```
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

----------


## wqweto

It doesn't work with SQL Server though



```
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>

----------


## Schmidt

> 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"  :Wink:  ...

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.



```
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

----------


## wqweto

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>

----------


## Schmidt

> ...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:


```
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:


```
    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

----------


## wqweto

> 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>

----------


## Schmidt

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


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





> 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

----------

