Home > Technology, Tutorials, VB6 > Cloning VB6 Recordsets

Cloning VB6 Recordsets

This is a re-printing of an article I originally posted on VBForums.com. In it I describe a problem I was having with the Clone method of the Recordset object in VB6, and then go on to explain a function I wrote to overcome the problems and limitations. the article is re-printed in its original text, unedited except for a few minor formatting issues. I never did get around to the refinements I wanted to make.


There have been a number of times when I found 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 independent of each other, but I also needed a way to sort, filter, and update the information independent. Using .Clone wouldn’t allow 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.

Advertisements
Categories: Technology, Tutorials, VB6
  1. No comments yet.
  1. No trackbacks yet.

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s

%d bloggers like this: