Faster recordset copying with ADO

I'm using ADO 2.7 to manage a disconnected database in a VB6 app. I want a really fast method of cutting and pasting records.

The ADO Filter property is good for the cut/copy and delete stages but the real bottleneck is in pasting.

The GetRows method provides a fast way of getting records into a 2D variant array which can then be manipulated. But there is no SetRows method to take the "pasted" 2D array so I'm forced, one way or another, to iterate through the edited array to update the recordset field by field - slow !

One tempting alternative is to use streams. No problem saving a recordset to a stream using str.Save, but I can't find a way of writing several blocks of records to the same stream.

Each stream Save adds an ADO header, so that I can only read back from the stream the first recordset I saved.

I'd be quite happy to tackle the problem using direct memory transfers with objPtr/varPtr etc. but can't find any information on how to do this.

Grateful for any help you can give on what must be an increasingly common problem for "disconnected " ADO users.
Who is Participating?
oh, and for clarification, datanode1 and datanode2 are just pointers to the <Data> tag in each of the two XML documents (created from the saved recordsets).  So, what you are doing with the appendchild is reading the <row:> elements starting from datanode2 and appending them to the <row:> elements under the datanode1
Not sure if this will help but its a thought.  Could you use the DTS Object library to create a DTS package?

Just use variables to set the source server, login, db and destination server, login db.


Set a reference to Microsoft DTSPackage Object Library

Option Explicit
Public goPackageOld As New DTS.Package
Public goPackage As DTS.Package2
Private Sub Main()
        Set goPackage = goPackageOld

        goPackage.Name = "New Package"
        goPackage.Description = "DTS package description"
        goPackage.WriteCompletionStatusToNTEventLog = False
        goPackage.FailOnError = False
        goPackage.PackagePriorityClass = 2
        goPackage.MaxConcurrentSteps = 4
        goPackage.LineageOptions = 0
        goPackage.UseTransaction = True
        goPackage.TransactionIsolationLevel = 4096
        goPackage.AutoCommitTransaction = True
        goPackage.RepositoryMetadataOptions = 0
        goPackage.UseOLEDBServiceComponents = True
        goPackage.LogToSQLServer = False
        goPackage.LogServerFlags = 0
        goPackage.FailPackageOnLogFailure = False
        goPackage.ExplicitGlobalVariables = False
        goPackage.PackageType = 0

Dim oConnProperty As DTS.OleDBProperty

' create package steps information

Dim oStep As DTS.Step2
Dim oPrecConstraint As DTS.PrecedenceConstraint

'------------- a new step defined below

Set oStep = goPackage.Steps.New

        oStep.Name = "Copy SQL Server Objects"
        oStep.Description = "Copy SQL Server Objects"
        oStep.ExecutionStatus = 1
        oStep.TaskName = "Copy SQL Server Objects"
        oStep.CommitSuccess = False
        oStep.RollbackFailure = False
        oStep.ScriptLanguage = "VBScript"
        oStep.AddGlobalVariables = True
        oStep.RelativePriority = 3
        oStep.CloseConnection = False
        oStep.ExecuteInMainThread = False
        oStep.IsPackageDSORowset = False
        oStep.JoinTransactionIfPresent = False
        oStep.DisableStep = False
        oStep.FailPackageOnError = False
goPackage.Steps.Add oStep
Set oStep = Nothing

' create package tasks information

'------------- call Task_Sub1 for task Copy SQL Server Objects (Copy SQL Server Objects)
Call Task_Sub1(goPackage)

' Save or execute package

'goPackage.SaveToSQLServer "(local)", "sa", ""
tracePackageError goPackage
'to save a package instead of executing it, comment out the executing package line above and uncomment the saving package line
Set goPackage = Nothing

Set goPackageOld = Nothing

End Sub

' error reporting using step.GetExecutionErrorInfo after execution
Public Sub tracePackageError(oPackage As DTS.Package)
Dim ErrorCode As Long
Dim ErrorSource As String
Dim ErrorDescription As String
Dim ErrorHelpFile As String
Dim ErrorHelpContext As Long
Dim ErrorIDofInterfaceWithError As String
Dim i As Integer

        For i = 1 To oPackage.Steps.Count
                If oPackage.Steps(i).ExecutionResult = DTSStepExecResult_Failure Then
                        oPackage.Steps(i).GetExecutionErrorInfo ErrorCode, ErrorSource, ErrorDescription, _
                                        ErrorHelpFile, ErrorHelpContext, ErrorIDofInterfaceWithError
                        MsgBox oPackage.Steps(i).Name & " failed" & vbCrLf & ErrorSource & vbCrLf & ErrorDescription
                End If
        Next i

End Sub

'------------- define Task_Sub1 for task Copy SQL Server Objects (Copy SQL Server Objects)
Public Sub Task_Sub1(ByVal goPackage As Object)

Dim oTask As DTS.Task
Dim oLookup As DTS.Lookup

Dim oCustomTask1 As DTS.TransferObjectsTask2
Set oTask = goPackage.Tasks.New("DTSTransferObjectsTask")
oTask.Name = "Copy SQL Server Objects"
Set oCustomTask1 = oTask.CustomTask

        oCustomTask1.Name = "Copy SQL Server Objects"
        oCustomTask1.Description = "Copy SQL Server Objects"
        oCustomTask1.SourceServer = "ServerName"
        oCustomTask1.SourceLogin = "LogonName"
        oCustomTask1.SourceUseTrustedConnection = False
        oCustomTask1.SourceDatabase = "SourceDB"
        oCustomTask1.DestinationServer = "DestinationServer"
        oCustomTask1.DestinationLogin = "LogonName"
        oCustomTask1.DestinationUseTrustedConnection = False
        oCustomTask1.DestinationDatabase = "DestinationDB"
        oCustomTask1.ScriptFileDirectory = "Path to Script File Directory" 'C:\Program Files\Microsoft SQL Server\80\Tools
        oCustomTask1.CopyAllObjects = True
        oCustomTask1.IncludeDependencies = True
        oCustomTask1.IncludeLogins = False
        oCustomTask1.IncludeUsers = True
        oCustomTask1.DropDestinationObjectsFirst = True
        oCustomTask1.CopySchema = True
        oCustomTask1.CopyData = 1
        oCustomTask1.ScriptOption = -2147061505
        oCustomTask1.ScriptOptionEx = 4112
        oCustomTask1.SourceTranslateChar = True
        oCustomTask1.DestTranslateChar = True
        oCustomTask1.DestUseTransaction = False
        oCustomTask1.UseCollation = False
goPackage.Tasks.Add oTask
Set oCustomTask1 = Nothing
Set oTask = Nothing

End Sub
Another thought is that you can save your recordset to a DOM object using the PersistXML flag, and then it might be faster to append the nodes of one DOM to the nodes of another DOM and then load the whole thing back into a recordset.  I'm not sure if you'd have to go attribute by attribute (field by field), I think you could just get each complete element (row) into a node and append that to the other DOM.
Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

Example, say that DOM1 holds the destination data and DOM2 holds the source data:

Public Dom1 As MSXML2.DOMDocument30
Public Dom2 As MSXML2.DOMDocument30

Public DataNode1 As MSXML2.IXMLDOMElement
Public DataNode2 As MSXML2.IXMLDOMElement

 Set DataNode1 = Dom1.documentElement.childNodes(1)
 Set DataNode2 = Dom2.documentElement.childNodes(1)

 for i = 1 to DataNode2.childNodes.length
 Next i

I could be off on the indexes, but that should point you in the direction I'm thinking...

Anthony PerkinsCommented:
>> One tempting alternative is to use streams. No problem saving a recordset to a stream using str.Save, but I can't find a way of writing several blocks of records to the same stream. <<

Each stream Save adds an ADO header, so that I can only read back from the stream the first recordset
I saved.

Perhaps I am missing the point, but should not the following work:

Dim rs As ADODB.Recordset
Dim stm As ADODB.Stream

Set rs = New ADODB.Recordset
With rs
    .Source = "Select * from Customers"
    .ActiveConnection = "NorthWind connection string"
    .CursorType = adOpenDynamic
    .LockType = adLockOptimistic
    .Open Options:=adCmdText
'    ...
    .Filter = "Country ='USA'"
    Set stm = New ADODB.Stream
    .Save stm
End With
' ...
rs.Open stm

' ...


Set rs = Nothing
Set stm = Nothing

jonrmorganAuthor Commented:
Thanks for the comments so far. My reaction is that raizon's suggestion is a mighty sledgehammer to crack the nut, especially on a disconnected dataset, that takes me way beyond the scope of the VB/ADO problem. And resorting to XML/DOM also seems a tad heavy handed.

All I want to do is cut/copy a record from the ADO recordset and put it back in another place without having to iterate through all the fields to do it.

On the comment from acperkins, yes, I know how to read a recordset into a stream but what I need to do in cut/paste is to merge parts of a recordset and some records from a paste buffer into the stream and then get the whole lot back from the stream as the pasted recordset. Because each time you save recordset data to a stream, everything, including the schema data gets chucked in you can't use this method to cut n' paste - as far as I can see. Please prove me wrong.

Thanks anyway guys, I'll keep looking for a simple ( but fast!) solution.
Granted, the DOM approach is doing a lot of work, in an attempt to save you a lot of work, and if you're only cutting and pasting one or two records, then it's probably not worth it.  But, if you're going to be doing a lot of cutting and pasting, then I don't think it's too much to do.  The operations to save to a DOM and read from a DOM are really pretty fast, and while the DOMs are kind of heavy objects, you could get away with instantiating them only once, this approach does satisfy your requirements.  

Here is a working sample so you can try it for yourself.  You'll need to edit the connect string, SQL and field names.  I think you could bury a lot of this in a couple of simple function calls and it wouldn't seem so painful.

You'll need to reference ADO and also the XML Parser (I used Version 3, if you use a different version, you might have to fix the declares of the Dom documents)

Public CN As ADODB.Connection
Public RS1 As ADODB.Recordset
Public RS2 As ADODB.Recordset
Public Dom1 As MSXML2.DOMDocument30
Public Dom2 As MSXML2.DOMDocument30
Public DataNode1 As MSXML2.IXMLDOMElement
Public DataNode2 As MSXML2.IXMLDOMElement

Private Sub Command1_Click()
' This is the important stuff **********************
Set DataNode1 = Dom1.documentElement.childNodes(1)
Set DataNode2 = Dom2.documentElement.childNodes(1)

For i = 0 To DataNode2.childNodes.Length - 1
    DataNode1.appendChild DataNode2.childNodes(i)
Next i

Set RS1 = New ADODB.Recordset
RS1.Open Dom1

' this just proves that it worked
If RS1.State = adStateOpen Then
    RS1.Find "user_no = 109"
    If RS1.EOF Or RS1.BOF Then
        MsgBox "Failed to append record"
        MsgBox RS1("user_lastname").Value
    End If
End If

End Sub

Private Sub Form_Load()
Dim i As Long

Set CN = New ADODB.Connection
CN.CursorLocation = adUseClient
CN.ConnectionString = "Provider=MSDASQL.1;Persist Security Info=False;DRIVER=SQL Server;SERVER=MYServer;DATABASE=MYDB;Trusted_Connection=Yes;Initial Catalog=MYDB"
If Not CN.State = adStateOpen Then
    MsgBox "Connection Failed"
    Exit Sub
End If

Set RS1 = New ADODB.Recordset
RS1.LockType = adLockBatchOptimistic
RS1.CursorType = adOpenStatic
RS1.ActiveConnection = CN
RS1.Source = "select * from user_base where user_no <> 109"
If Not RS1.State = adStateOpen Then
    MsgBox "Recordset 1 Open Failed"
    Exit Sub
End If

RS1.Find "user_no = 109"
If RS1.EOF Or RS1.BOF Then
    MsgBox "User Not Found"
    MsgBox RS1("user_lastname").Value
End If
Set RS1.ActiveConnection = Nothing

' This is the important stuff *******************
Set Dom1 = New MSXML2.DOMDocument30
RS1.Save Dom1, adPersistXML
' ***********************************************

Set RS2 = New ADODB.Recordset
RS2.LockType = adLockBatchOptimistic
RS2.CursorType = adOpenStatic
RS2.ActiveConnection = CN
RS2.Source = "select * from user_base where user_no = 109"
If Not RS2.State = adStateOpen Then
    MsgBox "Recordset 2 Open Failed"
    Exit Sub
End If
Set RS2.ActiveConnection = Nothing

' This is the important stuff *******************
Set Dom2 = New MSXML2.DOMDocument30
RS2.Save Dom2, adPersistXML
' ***********************************************

End Sub
jonrmorganAuthor Commented:
Thanks for the code example. I put a reference to the XML parser in my app, but the code falls down at the first assignment :

Set DataNode1=Dom1.documentElement.ChildNodes(1)

with "Object variable or With Block variable not set"

I think though I can follow what the code is trying to do.

The idea is (?) that DataNode 2 (which contains RS2) is appended to Dom1 which holds RS1.

However won't this append ALL of RS2 to RS1 including its' schema data ? If so then it won't be possible to merge the recordsets using this method. This is the same problem I had using Streams to merge recordsets - when you open RS3 to the stream containing RS1 and RS2 all you get is RS1.

Sorry to be so negative - I really hadn't thought it was such an awkward problem. Couldn't I just hack the recordset using objPtr/varPtr and CopyMemory ? I gave it a try but working out where the data really is in a Safearray is pretty tricky !
You have to make sure that DOM1 includes the recordset that you want to append to.  If that recordset doesn't have any records, then you're right, there might not be a ChildNodes(1).  When a recordset is saved as XML you get something like:

If the DOM contains a recordset (my recordset save was in the form load procedure) then the Data tag should be the second child node under the document.  If you have an empty recordset or never saved the recordset to the DOM I could see that you would get that error.

If you filter your RS2 before you save it to the DOM, you will only get the filtered records written to the DOM's XML, so, if you don't want all of RS2 to be appended to RS1 then filter RS2 before you save it.

You're right, that after doing the appendChilds RS1 will now contain the records from RS2 that you appended (I thought that was the point).  If you then open an RS3 and filter it and append it to RS1 then RS1 will have records originally from RS1, RS2 and RS3.  I don't think that the appendChild will do anything with the schema data, since we're now in the XML world, it wont touch that node unless you tell it to.  If you merged in records with a different schema than what was in RS1 you will likely run into problems when you try to put the XML back into a recordset.

If that's not what you're trying to do, then help clarify that, as this is the assumption I'm going on.

You probably can hack it, but, you're likely to throw a lot of the recordset properties out of whack, like the counts, absolute position etc.
jonrmorganAuthor Commented:
Thanks for your persistence - I'll give it another try. I'm sure it deserves more than 75 points but as a newbie that's all there is.
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.