Comparing, Updating and Appending Two ADODB Recordsets

Hi,

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
                            Else
                                rst2.Fields(i).Value = rst.Fields(i).Value
                            End If
                       Next i
                       rst2.Update
                            '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
                       rst2.AddNew
                        For i = 0 To rst.Fields.Count - 1
                            If IsNull(rst.Fields(i).Value) = True And i > 0 Then
                                rst2.Fields(i).Value = Null
                            Else
                                rst2.Fields(i).Value = rst.Fields(i).Value
                            End If
                        Next i
                       rst2.Update
                   End If
                rst2.MoveNext
            Loop
            
UpdatedRecord:
    
            'Move to next record in rst source table recordset
            rst.MoveNext
            'Move back to the first record in the rst2 destination table recordset
            rst2.MoveFirst
    
        Loop
            'Now we have searched every record in the rst2 destination table recordset for every record in rst source table recordset looking for matching records
            rst2.Close
            Set rst2 = Nothing
        
NothingToUpdate:
          
            rst.Close
            Set rst = Nothing
            
            'Now move to the next table in the database and do it all over again
            rst3.MoveNext
            If rst3.EOF = True Then Exit Do
            
    Loop
    
    rst3.Close
    Set rst3 = Nothing
    
    conn.Close
    conn2.Close
    conn3.Close
    
    'Delete Source Database and Source Image files from Host computer
    fso.DeleteFile strFromPath & "\*.*", True
    fso.DeleteFolder strFromPath & "\*.*", True
    
Exit_cmdExitSub_Click:
    Exit Sub
 
Err_cmdExitSub_Click:
    
    MsgBox "Err = " & Err.Number & " Error Description = " & Err.Description
    Resume Exit_cmdExitSub_Click

Select allOpen in new window