Comparing, Updating and Appending Two ADODB Recordsets

Posted on 2013-07-01
Last Modified: 2013-07-12

I would like some expert assistance with the following project.  I use a medical diagnostic device that uses a proprietary VB6 application to acquire certain metrics and then manages these metrics with an access (mdb data file type) database.  To make things interesting, the diagnostic device cannot be networked and it is not possible to change the path to the database in the VB6 application as we have no access to the source code.  

The VB6 application has built in export functions but they are cumbersome and slow to use.  The company provides an identical VB6 application that can be installed on peripheral computers, however that VB6 application can only point to the local database on the local computer (again the path is not editable without source code access).  Therefore, the method of moving data from the diagnostic device to the peripheral computer running the VB6 app is by using an interface in the VB6 application for data export and import.  The challenge is that this export function is cumbersome and slow and must be done by sequentially exporting data from the medical device and then importing that data into the peripheral database.  This process can currently only be done “manually” one peripheral computer at a time.  Conversely, if the user edits the data on the peripheral computer, the only way to update the database on the medical device it to reverse the export and import steps.

In order to automate access to this data, I would like to effectively “clone” this database to my network – in effect providing an exact copy of the database on the diagnostic device on each client on my network using vba.  First I export the necessary tables and records from the device using the built in export interface.  Then I copy the files to each peripheral computer and then use my code running locally to automatically import these tables / records into the local database present on each local computer.

I have successfully done that using the following posted vba code.  However, it works best if I am appending new data to the master database.  If I am updating records, it imports the data correctly but appears to intermittently screw up some of the relationships between various tables.

There are 10 normalized tables that are exported in a specific export function.  Essentially my code connects to the two mdb databases (source database and destination database) using ADODB recordsets then cycles through the tables updating records based on matches on the primary key of each table and, if no match is found, appends a new record to the table.

I am wondering if an entirely different approach might work better or if I am missing something in this process.  Perhaps writing the fields one at a time can disrupt internal one-to-one relationships in the database?  
    Dim conn As ADODB.Connection
    Dim conn2 As ADODB.Connection
    Dim conn3 As ADODB.Connection
    Dim rst As ADODB.Recordset
    Dim rst2 As ADODB.Recordset
    Dim rst3 As ADODB.Recordset
    Dim strDBSource As String
    Dim strSysDBSource As String
    Dim strDBDest As String
    Dim strSysDBDest As String
    Dim strSQL As String
    Dim strDatabasePathSource As String
    Dim strDatabasePathDest As String
    Dim strMDWName As String
    Dim strMDBName As String
    Dim strTable As String
    Dim i As Integer
    On Error GoTo Err_cmdExitSub_Click

    strDatabasePathSource = strFromPath
    strDatabasePathDest = strToPath
    strMDBName = "MyDb.mdb"
    strMDWName = "MyDb.mdw"
    strDBSource = strDatabasePathSource & strMDBName
    strSysDBSource = strDatabasePathSource & strMDWName
    strDBDest = strDatabasePathDest & strMDBName
    strSysDBDest = strDatabasePathDest & strMDWName
    Set conn = New ADODB.Connection
    conn.Provider = "Microsoft.Jet.OLEDB.4.0"
    conn.Properties("Data Source") = strDBSource
    conn.Properties("Jet OLEDB:System database") = strSysDBSource
    conn.Properties("Jet OLEDB:Database Password") = "XXX333"
    conn.Open UserId:="WSDatabase", Password:="YYY444"
    Set conn2 = New ADODB.Connection
    conn2.Provider = "Microsoft.Jet.OLEDB.4.0"
    conn2.Properties("Data Source") = strDBDest
    conn2.Properties("Jet OLEDB:System database") = strSysDBDest
    conn2.Properties("Jet OLEDB:Database Password") = "XXX333"
    conn2.Open UserId:="WSDatabase", Password:="YYY444"
    Set rst3 = New ADODB.Recordset
    With rst3
        .CursorType = adOpenKeyset
        .LockType = adLockOptimistic
        .CursorLocation = adUseServer
    End With
    Set conn3 = CurrentProject.Connection
    rst3.Open "tblDBTables", conn3
    'Start with each table in the database sequence
    'rst3 is the recordset that contains the table names
    Do While rst3.EOF = False
        strTable = rst3.Fields(1).Value
        'rst is the recordset that contains the records from the source table
        Set rst = New ADODB.Recordset
        With rst
            .CursorType = adOpenKeyset
            .LockType = adLockOptimistic
            .CursorLocation = adUseServer
            .Open strTable, conn
        End With
        If rst.RecordCount = 0 Then
            'If the source table is empty then skip updating and appending process and go to the next table
            GoTo NothingToUpdate
        End If
        'rst2 is the recordset that contains the records in the destination table
        Set rst2 = New ADODB.Recordset
        With rst2
            .CursorType = adOpenKeyset
            .LockType = adLockOptimistic
            .CursorLocation = adUseServer
            .Open strTable, conn2
        End With
        'Start updating and / or appending the destination tables
        'rst is the new data source table recordset
        'rst2 is the current destination table recordset
        'For each record in rst find the matching record in rst2.
        'If found then update the record in rst2 to match the record in rst
        'If not found then append record to rst2 destination table recordset
        Do While rst.EOF = False
            'Loop through rst2 destination recordset looking for matching records
            Do While rst2.EOF = False
                    'Edit the Record if primary key values are equal
                   If rst2.Fields(0).Value = rst.Fields(0).Value Then
                       For i = 0 To rst.Fields.Count - 1
                            If IsNull(rst.Fields(i).Value) = True Then
                                rst2.Fields(i).Value = Null
                                rst2.Fields(i).Value = rst.Fields(i).Value
                            End If
                       Next i
                            'If the rst2 destination table recordset has been updated then move back to first record and look for the next match
                            If rst2.AbsolutePosition < rst2.RecordCount Then
                                GoTo UpdatedRecord
                            End If
                   End If
                    'We have come to the end of the rst2 destination recordset and no match has been found so append record instead of editing
                   If rst2.AbsolutePosition = rst2.RecordCount And rst2.Fields(0).Value <> rst.Fields(0).Value Then
                        For i = 0 To rst.Fields.Count - 1
                            If IsNull(rst.Fields(i).Value) = True And i > 0 Then
                                rst2.Fields(i).Value = Null
                                rst2.Fields(i).Value = rst.Fields(i).Value
                            End If
                        Next i
                   End If
            'Move to next record in rst source table recordset
            'Move back to the first record in the rst2 destination table recordset
            'Now we have searched every record in the rst2 destination table recordset for every record in rst source table recordset looking for matching records
            Set rst2 = Nothing
            Set rst = Nothing
            'Now move to the next table in the database and do it all over again
            If rst3.EOF = True Then Exit Do
    Set rst3 = Nothing
    'Delete Source Database and Source Image files from Host computer
    fso.DeleteFile strFromPath & "\*.*", True
    fso.DeleteFolder strFromPath & "\*.*", True
    Exit Sub
    MsgBox "Err = " & Err.Number & " Error Description = " & Err.Description
    Resume Exit_cmdExitSub_Click

Open in new window

Question by:isurgyn
  • 4
LVL 45

Expert Comment

ID: 39293106
One of my clients has a similar problem.  I have the operators run an end-of-day batch file to copy their local .MDB file up to the file server and then run a consolidation job that night.  Whenever possible, I use queries to do the work, since they are usually much faster than VBA code.

On an irregular basis, I go through a clean-up process on the consolidated data and push the data back out to the other databases.  I've added a column to a couple of the tables in the consolidated image to let me know where the data/change came from.

What you want to do can be done, but it isn't trivial.
LVL 76

Expert Comment

ID: 39293125
It sounds as if database Replication and Synchronisation would be the ideal solution here, but it would require the co-operation and involvement of your network administration.

Author Comment

ID: 39293317
The data needs to be moved periodically throughout the day so that the physicians can view the data / images when they are seeing patients in the clinic so a daily batch won't really suffice.

Database replication and synchronization might work.  I will look at that idea.  

The code that I have is fairly fast - the entire move process updates all of the client computers in less than 5 seconds from export so that is definitely adequate even though I am using VBA.  The challenge is that it works to move the data but the VB6 application will intermittently not care for the data relationships which could be caused by the order in which I am updating the tables but I am not sure.

On the query solution, I had considered that but because both db's are password protected and use an mdw file to open it seemed easier to use the ADODB recordset process.  How would you suggest using a query rather than the search and field uptdate processing?  I did attempt to use an sql SELECT method to find matched and unmatched records but couldn't get my syntax right using the recordsets but fundamentally that would still require writing the records one at a time using VBA.
Three Reasons Why Backup is Strategic

Backup is strategic to your business because your data is strategic to your business. Without backup, your business will fail. This white paper explains why it is vital for you to design and immediately execute a backup strategy to protect 100 percent of your data.


Author Comment

ID: 39293571
Also, for clarification, the data export involves tables that typically only have between 1 and maybe 20 records at most, while the primary destination database has tables that may have thousands of records.  Without much more investigation that doesn't sound to me like database replication / synchronization would work unless I pulled the entire mdb file off of the device each time I needed to update.

My perception is that the simplest and cleanest method is to reverse engineer the import function so that I can automate it.  Perhaps I should write the tables from both databases to a central database and then use a query method to update them? Once I have the consolidated tables then write the entire set of tables back to the distributed mdb files?

Accepted Solution

isurgyn earned 0 total points
ID: 39306260
OK I discovered why I was getting the intermittent wonky effects where the VB6 application thought that some of the image files had been archived.  I thought that it was an error in my update or append method or perhaps the order in which I moved the table.  It was neither.

I have the code on a timer interval set for 5 seconds.  Their is other code that essentially sweeps a specific folder looking for the new exported database and related images.  When they arrive the update and append process is initiated.

It turned out that when I was transferring more than 20 image files, the files were not done copying before the code ran again.  To solve the problem I simply changed the interval timer to 15 seconds and the problem vanished.

In conclusion, the posted code works flawlessly for its intended purpose.

Author Closing Comment

ID: 39320157
The other comments were not helpful in any way in solving the problem, nor did they comment on the code methods suggesting problems with the approach.

Featured Post

Networking for the Cloud Era

Join Microsoft and Riverbed for a discussion and demonstration of enhancements to SteelConnect:
-One-click orchestration and cloud connectivity in Azure environments
-Tight integration of SD-WAN and WAN optimization capabilities
-Scalability and resiliency equal to a data center

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Experts-Exchange is a great place to come for help with solutions for your database issues, and many problems are resolved within minutes of being posted.  Others take a little more time and effort and often providing a sample database is very helpf…
Describes a method of obtaining an object variable to an already running instance of Microsoft Access so that it can be controlled via automation.
Learn how to number pages in an Access report over each group. Activate two pass printing by referencing the pages property: Add code to the Page Footers OnFormat event to capture the pages as there occur for each group. Use the pages property to …
What’s inside an Access Desktop Database. Will look at the basic interface, Navigation Pane (Database Container), Tables, Queries, Forms, Report, Macro’s, and VBA code.

820 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question