Comparing, Updating and Appending Two ADODB Recordsets


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

Who is Participating?
isurgynConnect With a Mentor Author Commented:
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.
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.
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.
7 new features that'll make your work life better

It’s our mission to create a product that solves the huge challenges you face at work every day. In case you missed it, here are 7 delightful things we've added recently to monday to make it even more awesome.

isurgynAuthor Commented:
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.
isurgynAuthor Commented:
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?
isurgynAuthor Commented:
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.
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.