Creating Disconnected Recordset Clones-VBForums
Results 1 to 3 of 3

Thread: Creating Disconnected Recordset Clones

  1. #1

    Thread Starter
    Join Date
    May 2002

    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:
    1. 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:
    1. Private Function DisconnectedCloneEx(ByVal rstData As ADODB.Recordset, Optional ByRef FieldList As ADODB.Recordset = Nothing, Optional ByVal PostPend As Boolean = True) As ADODB.Recordset
    3. Dim fld As ADODB.Field
    4. Dim rst As ADODB.Recordset
    5. Dim lngFldCount As Long
    7. On Error GoTo errHandler
    9.     'Create a recordset object
    10.     Set rst = New ADODB.Recordset
    12.     'If a Field collection was passed in and it is to be pre-pended to the recordset....
    13.     If (Not PostPend) And Not (FieldList Is Nothing) Then
    14.         'Copy the field definitions
    15.         For Each fld In FieldList.Fields
    16.             'We have to make sure the field is nullable
    17.             If (fld.Attributes And adFldIsNullable) <> adFldIsNullable Then
    18.                 fld.Attributes = fld.Attributes + adFldIsNullable
    19.             End If
    21.             rst.Fields.Append fld.Name, fld.Type, fld.DefinedSize, fld.Attributes
    23.             If fld.Precision > 0 Then
    24.                 rst.Fields(fld.Name).Precision = fld.Precision
    25.             End If
    26.             If fld.NumericScale > 0 Then
    27.                 rst.Fields(fld.Name).NumericScale = fld.NumericScale
    28.             End If
    29.         Next
    30.     End If
    32.     'Copy the field definition
    33.     For Each fld In rstData.Fields
    34.         rst.Fields.Append fld.Name, fld.Type, fld.DefinedSize, fld.Attributes
    35.         If fld.Precision > 0 Then
    36.             rst.Fields(fld.Name).Precision = fld.Precision
    37.         End If
    38.         If fld.NumericScale > 0 Then
    39.             rst.Fields(fld.Name).NumericScale = fld.NumericScale
    40.         End If
    41.     Next
    43.     'If a Field collection was passed in and it is to be post-pended to the recordset....
    44.     If (PostPend) And Not (FieldList Is Nothing) Then
    45.         'Copy the field definition
    46.         For Each fld In FieldList.Fields
    48.             'We have to make sure the field is nullable
    49.             If (fld.Attributes And adFldIsNullable) <> adFldIsNullable Then
    50.                 fld.Attributes = fld.Attributes + adFldIsNullable
    51.             End If
    53.             rst.Fields.Append fld.Name, fld.Type, fld.DefinedSize, fld.Attributes
    55.             If fld.Precision > 0 Then
    56.                 rst.Fields(fld.Name).Precision = fld.Precision
    57.             End If
    58.             If fld.NumericScale > 0 Then
    59.                 rst.Fields(fld.Name).NumericScale = fld.NumericScale
    60.             End If
    61.         Next
    62.     End If
    64.     'Use a client cursor
    65.     rst.CursorLocation = adUseClient
    66.     'Open the recordset
    67.     rst.Open , , adOpenKeyset
    69.     If Not (rstData.EOF And rstData.BOF) Then
    70.         rstData.MoveFirst
    71.     End If
    73.     'loop through the source recordset and copy the data
    74.     Do While Not rstData.EOF
    75.         'Add a new records
    76.         rst.AddNew
    77.         'Copy the field values
    78.         For Each fld In rstData.Fields
    79.             rst.Fields(fld.Name).Value = rstData.Fields(fld.Name).Value
    80.         Next
    82.         'Next record
    83.         rstData.MoveNext
    84.     Loop
    86.     'If there was data to roll through,
    87.     If rst.RecordCount > 0 Then
    88.         'move to the begining of the source recordset
    89.         rst.MoveFirst
    90.     End If
    92.     'Return the clone
    93.     Set DisconnectedCloneEx = rst
    94.     'Release objects
    95.     Set rst = Nothing
    96.     Set fld = Nothing
    98.     Exit Function
    100. errHandler:
    101. On Error GoTo 0
    102.     Err.Raise Err.Number, Err.Source, Err.Description
    104. End Function

    An example of how I used this function (names changed to protect the innocent, and some guilty) :
    VB Code:
    1. Private Sub GetSomeInfo( PKeyID As Long)
    2. Dim cmdSelect As ADODB.Command
    3. Dim rstResults As ADODB.Recordset
    4. Dim rstNewFields As ADODB.Recordset
    6.     On Error GoTo errHandler
    7.     Set cmdSelect = New ADODB.Command
    8.     With cmdSelect
    9.         .CommandText = "sp_SelectSomeDBInfo"
    10.         .CommandType = adCmdStoredProc
    11.         .CommandTimeout = TIME_OUT
    12.         .Parameters.Append .CreateParameter("@PKeyID", adInteger, adParamInput, , 0)  'NomGroupID)
    13.         Set .ActiveConnection = mobjDBConnection
    14.         Set rstResults = .Execute
    15.     End With
    17.     Set rstResults.ActiveConnection = Nothing
    19.     Set rstNewFields = New ADODB.Recordset
    20.     rstNewFields.Fields.Append "Processed", adBoolean, , adFldIsNullable
    21.     'fields need to allow for Null, since there is not default value and we don't know what value to put here
    23.     Set mrstMyRecordset = DisconnectedCloneEx(rstResults, rstNewFields, True)
    25.     Set cmdSelect = Nothing
    27.     Exit Sub
    28. errHandler:
    29.     Set mrstMyRecordset = Nothing
    31. 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.


    -NOTE: the attachment is a text file of this post, with the code in it.
    Attached Files Attached Files
    Last edited by techgnome; Jun 10th, 2010 at 08:05 AM.
    * I don't respond to private (PM) requests for help. It's not conducive to the general learning of others.*
    * I also don't respond to friend requests. Save a few bits and don't bother. I'll just end up rejecting anyways.*
    * How to get EFFECTIVE help: The Hitchhiker's Guide to Getting Help at VBF - Removing eels from your hovercraft *
    * How to Use Parameters * Create Disconnected ADO Recordset Clones * Set your VB6 ActiveX Compatibility * Get rid of those pesky VB Line Numbers * I swear I saved my data, where'd it run off to??? *

  2. #2
    New Member
    Join Date
    Sep 2013

    Thumbs up Re: Creating Disconnected Recordset Clones

    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:

    VB Code:
    1. 'Use a client cursor
    2. rst.CursorLocation = adUseClient
    3. 'Open the recordset
    4. rst.Open , , adOpenKeyset

    VB Code:
    1. 'Use optimistic lock
    2. rst.LockType = adLockOptimistic
    3. 'Use open keyset
    4. rst.CursorType = adOpenKeyset
    5. 'Use a client cursor
    6. rst.CursorLocation = adUseClient
    7. 'Open the recordset
    8. 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

  3. #3
    Fanatic Member
    Join Date
    Jun 2013

    Re: Creating Disconnected Recordset Clones

    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

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts


Click Here to Expand Forum to Full Width

Survey posted by VBForums.