This example uses the Clone method to create copies of a Recordset and then lets the user position the record pointer of each copy independently.
'BeginCloneVB 'To integrate this code 'replace the data source and initial catalog values 'in the connection string Public Sub Main() On Error GoTo ErrorHandler 'recordset array and connection variables Dim arstStores(1 To 3) As ADODB.Recordset Dim Cnxn As ADODB.Connection Dim strSQLStore As String Dim strCnxn As String 'record variables Dim intLoop As Integer Dim strMessage As String Dim strFind As String ' Open a connection Set Cnxn = New ADODB.Connection strCnxn = "Provider='sqloledb';Data Source='MySqlServer';" & _ "Initial Catalog='Pubs';Integrated Security='SSPI';" Cnxn.Open strCnxn ' Open recordset as a static cursor type recordset Set arstStores(1) = New ADODB.Recordset strSQLStore = "SELECT stor_name FROM Stores ORDER BY stor_name" arstStores(1).Open strSQLStore, strCnxn, adOpenStatic, adLockBatchOptimistic, adCmdText ' Create two clones of the original Recordset Set arstStores(2) = arstStores(1).Clone Set arstStores(3) = arstStores(1).Clone ' Loop through the array so that on each pass the user ' is searching a different copy of the same Recordset Do For intLoop = 1 To 3 ' Ask for search string while showing where ' the current record pointer is for each Recordset strMessage = _ "Recordsets from stores table:" & vbCr & _ " 1 - Original - Record pointer at " & arstStores(1)!stor_name & vbCr & _ " 2 - Clone - Record pointer at " & arstStores(2)!stor_name & vbCr & _ " 3 - Clone - Record pointer at " & arstStores(3)!stor_name & vbCr & _ "Enter search string for #" & intLoop & ":" strFind = Trim(InputBox(strMessage)) ' make sure something was entered, if not then EXIT loop If strFind = "" Then Exit Do ' otherwise locate the record from the entered string arstStores(intLoop).Filter = "stor_name = '" & strFind & "'" 'if there's no match, jump to the last record If arstStores(intLoop).EOF Then arstStores(intLoop).Filter = adFilterNone arstStores(intLoop).MoveLast Else MsgBox "Found " & strFind End If Next intLoop Loop ' clean up arstStores(1).Close arstStores(2).Close arstStores(3).Close Cnxn.Close Set arstStores(1) = Nothing Set arstStores(2) = Nothing Set arstStores(3) = Nothing Set Cnxn = Nothing Exit Sub ErrorHandler: ' clean up If Not arstStores(1) Is Nothing Then If arstStores(1).State = adStateOpen Then arstStores(1).Close End If Set arstStores(1) = Nothing If Not arstStores(2) Is Nothing Then If arstStores(2).State = adStateOpen Then arstStores(2).Close End If Set arstStores(2) = Nothing If Not arstStores(3) Is Nothing Then If arstStores(3).State = adStateOpen Then arstStores(3).Close End If Set arstStores(3) = Nothing If Not Cnxn Is Nothing Then If Cnxn.State = adStateOpen Then Cnxn.Close End If Set Cnxn = Nothing If Err <> 0 Then MsgBox Err.Source & "-->" & Err.Description, , "Error" End If End Sub 'EndCloneVB
Clone Method | Recordset Object