Tables: Synchronization without Replication

There are a few explanations necessary. 

1. The system is set up to use random autonumbers, to reduce the chances of a duplicate key occurring. Each record also has a DateLastUpdated field, which is set to Now() at each change to that record, i.e. accurate to one second. The synchronization therefore relies on two conditions: If a key in a table on the Replica is not found on the table in the Master, the Replica record is added to the Master as a new record. If the key is found and the DateLastChanged on the Replica is the same as on the Master, then the Replica record is skipped. If the dates are different, the user supplied fields in Master and in Replica are presented to the operator side by side, for a decision on which record to accept. In that process the frmDifferences is editable, so the operator can make whatever changes are needed before accepting one or the other version.



2. The frmDifferences is a generic form which has 3 fields in columns, col.1 the field label (suitable for the user), col.2 the contents of the field on the Master and col.3 ditto on the Replica. If the field is a Combo box or a List box, they are presented as a list box with the values selected.
   
   
3. The system works in 3 steps:
       a) Link the Replica tables to the Master. This will create duplicate table names ending in 1 (but any character can be used). 
       b) Step through each table using the above algorithm to present those record which require user intervention. 
       c) Delete all the Replica tables from the Master. Now you can throw away the Replica and replace it with the master, to start afresh. 


4. [This last step could also be automated, but my client didn't want to spend the money.]

This code needs to be adapted to fit a particular case. It is suitable for small applications only. It works virtually without overhead (which was a real killer for standard replication) in our case, since it requires only a random key and a Date/Time field accurate to the second. 

It is possible for records to slip through the net, but highly unlikely: two random keys need to be created identical on separate computers, or two records need to have been updated independently at the same second on two widely separated computers. The risks are minimal and tolerable in this case. 

The weekly synchronization takes less then 5 minutes, and the operator feels fully in control.

'********* Code starts *********************************
' This code was originally written by Hans Karman
' It is not to be altered or distributed,
' except as part of an application.
' You are free to use it in any application,
' provided the copyright notice is left unchanged.
'
' Code Courtesy of
' Hans Karman
'
Private Sub cmdSynchronise_Click()
'
'Link replica, using the function LinkReplica (below)
'
    If Not LinkReplica() Then
        MsgBox "Replica not linked correctly.  Contact Programmer"
        DoCmd.Quit
    End If
    MsgBox "Link with replica completed, synchronisation started"
'
'Synchronise tables.  This could be automated by stepping through the Table
'collection and the field collection for each table.  In this Application the
'hard coded alternative was quicker.
'
'The sequence of the tables is important.  Synchronise the "lookup" Tables First
'to avoid missing records when updating the two last tables (which are the link
'tables in two many-to-many relations).
'
    DoCmd.Hourglass True
    SyncCategories   'Lookup table
    SyncConsultants  'Lookup table
    SyncDepartments  'Lookup table
    SyncSponsors  'Lookup table
    SyncStages    'Lookup table
    SyncJobs      'Main table
    SyncComments  'This is a table used in a subform to the Jobs form
    SyncJobConsultants  'Link table (many-to-many jobs/consultants)
    SyncJobSponsors  'Link table (many-to-many jobs/sponsors)
    DoCmd.Hourglass False
'
'Unlink Replica, using an unlinking function (below)
'
    MsgBox "Synchronisation completed, unlink replica"
    If Not UnLinkReplica() Then
        MsgBox "Replica not unlinked correctly.  Contact Programmer"
        DoCmd.Quit
    End If
    MsgBox "Replica unlinked.  Destroy replica and replace with copy of"
master ""
End Sub
'
Private Sub SyncCategories()
'
'Here is a table with only one user field
'
'Blank the global fields used to communicate with the frmDifferences Form
'
    InitialiseDifferences
'
'Table name
'
    XTable = "Categories"
    Set dbs = CurrentDb()
    Set master = dbs.OpenRecordset("tbl" & XTable, dbOpenDynaset)
    Set replica = dbs.OpenRecordset("tbl" & XTable & "1", dbOpenDynaset)
    replica.MoveFirst
    While Not replica.EOF
        master.FindFirst "CategoryID = " & replica!CategoryID
        If master.NoMatch Then
            master.AddNew
            master!CategoryID = replica!CategoryID
            master!Description = replica!Description
            master!DateLastChanged = replica!DateLastChanged
            master.Update
            MsgBox "New category added = " & replica!Description
        Else
            If replica!DateLastChanged <> master!DateLastChanged Then
      '
      'Set the global fields
      '
                XLabel1 = "Description"
                MField1 = master!Description
                RField1 = replica!Description
      '
      'Present them to the operator for decision
      '
                DoCmd.OpenForm "frmDifferences", , , , , acDialog
      '
      'The frmDifferences puts the operator selected fields
      'into the globals for the Master
      '
                master.Edit
                master!Description = MField1
                master!DateLastChanged = Now()
                master.Update
            End If
        End If
        replica.MoveNext
    Wend
    replica.Close
    master.Close
    Set master = Nothing
    Set rst = Nothing
    Set dbs = Nothing
End Sub
'
Private Sub SyncSponsors()
'
'This is a table which has a ComboBox field
'
    InitialiseDifferences
    XTable = "Sponsors"
    Set dbs = CurrentDb()
    Set master = dbs.OpenRecordset("tbl" & XTable, dbOpenDynaset)
    Set replica = dbs.OpenRecordset("tbl" & XTable & "1", dbOpenDynaset)
    replica.MoveFirst
    While Not replica.EOF
        master.FindFirst "SponsorID = " & replica!SponsorID
        If master.NoMatch Then
            master.AddNew
            master!SponsorID = replica!SponsorID
       '
       'This is the ComboBox Keyfield
       '
            master!DepartmentID = replica!DepartmentID
            master!Title = replica!Title
            master!Name = replica!Name
            master!Phone = replica!Phone
            master!Location = replica!Location
            master!DateLastChanged = replica!DateLastChanged
            master.Update
            MsgBox "New Sponsor added = " & replica!Name
        Else
            If replica!DateLastChanged <> master!DateLastChanged Then
                XLabel1 = "Title"
                MField1 = master!Title
                RField1 = replica!Title
                XLabel2 = "Name"
                MField2 = master!Name
                RField2 = replica!Name
                XLabel3 = "Phone"
                MField3 = master!Phone
                RField3 = replica!Phone
                XLabel4 = "Location"
                MField4 = master!Location
                RField4 = replica!Location
                XLabel6 = "Department"
      '
      'The comboboxes are handled in the frmDifferences
      '
                MCombo6 = master!DepartmentID
                RCombo6 = replica!DepartmentID
                DoCmd.OpenForm "frmDifferences", , , , , acDialog
                master.Edit
                master!Title = MField1
                master!Name = MField2
                master!Phone = MField3
                master!Location = MField4
                master!DepartmentID = MCombo6
                master!DateLastChanged = Now()
                master.Update
            End If
        End If
        replica.MoveNext
    Wend
    replica.Close
    master.Close
    Set master = Nothing
    Set rst = Nothing
    Set dbs = Nothing
End Sub
'
'The code behind the frmDifferences
'You can probably imagine what the frmDifferences looks like.  If necessary I can attach
'a small DB.  The columns are fxLabeln, fmFieldn and frFieldn (label, master, replica)
'
'------------- frmDifferences code ---------------------
Option Compare Database
Option Explicit
'
Private Sub cmdMaster_Click()
'
'Operator says "use master record"
'So we place the values from col.2 into the Master Globals
'for transmission to the Synchronisation process
'
    On Error GoTo Err_cmdMaster_Click
    MField1 = Me!fmField1
    MField2 = Me!fmField2
    MField3 = Me!fmField3
    MField4 = Me!fmField4
    MField5 = Me!fmField5
    If XLabel6 <> "" Then MCombo6 = Me!fMCombo6
    If XLabel7 <> "" Then MCombo7 = Me!fMCombo7
    DoCmd.Close
Exit_cmdMaster_Click:
    Exit Sub
Err_cmdMaster_Click:
    MsgBox Err.Description
    Resume Exit_cmdMaster_Click
End Sub
'
Private Sub cmdReplica_Click()
'
'Operator says "use replica record"
'So we place the values from col.3 into the Master Globals
'for transmission to the Synchronisation process
'
    On Error GoTo Err_cmdReplica_Click
    MField1 = Me!frField1
    MField2 = Me!frField2
    MField3 = Me!frField3
    MField4 = Me!frField4
    MField5 = Me!frField5
    If XLabel6 <> "" Then MCombo6 = Me!fRCombo6
    If XLabel7 <> "" Then MCombo7 = Me!fRCombo7
    DoCmd.Close
Exit_cmdReplica_Click:
    Exit Sub
Err_cmdReplica_Click:
    MsgBox Err.Description
    Resume Exit_cmdReplica_Click
End Sub
'
Private Sub Form_Load()
'
'Load the globals into the 3 columns of data
'
    Me!fXTable = XTable
    Me!fLabel1 = XLabel1
    Me!fmField1 = MField1
    Me!frField1 = RField1
    Me!fLabel2 = XLabel2
    Me!fmField2 = MField2
    Me!frField2 = RField2
    Me!fLabel3 = XLabel3
    Me!fmField3 = MField3
    Me!frField3 = RField3
    Me!fLabel4 = XLabel4
    Me!fmField4 = MField4
    Me!frField4 = RField4
    Me!fLabel5 = XLabel5
    Me!fmField5 = MField5
    Me!frField5 = RField5
    Me!fLabel6 = XLabel6
    If XLabel6 <> "" Then
        SetComboBox6
    End If
    Me!fLabel7 = XLabel7
    If XLabel7 <> "" Then
        SetComboBox7
    End If
End Sub
'
Private Sub SetComboBox6()
'
'This is a combobox.  So we set the List box Properties to present the appropriate Values
'The label value determines the combobox type
'
    Select Case XLabel6
        Case "Department"
            Me.RecordSource = "tblDepartments"
            fMCombo6.DefaultValue = MCombo6
            fMCombo6.RowSource = "SELECT DISTINCTROW [tblDepartments].[DepartmentID], " & _
                "[tblDepartments].[Branch], [tblDepartments].[ShortDepartment] " & _
                "FROM [tblDepartments];"
            fMCombo6.ColumnCount = 3
            fMCombo6.ColumnWidths = "0cm;3.8cm;0.75cm"
            fMCombo6.BoundColumn = 1
            fRCombo6.DefaultValue = RCombo6
            fRCombo6.RowSource = "SELECT DISTINCTROW [tblDepartments].[DepartmentID], " & _
                "[tblDepartments].[Branch], [tblDepartments].[ShortDepartment] " & _
                "FROM [tblDepartments];"
            fRCombo6.ColumnCount = 3
            fRCombo6.ColumnWidths = "0cm;3.8cm;0.75cm"
            fRCombo6.BoundColumn = 1
        Case "Category"
            Me.RecordSource = "tblCategories"
            fMCombo6.DefaultValue = MCombo6
            fMCombo6.RowSource = "SELECT DISTINCTROW [tblCategories].[CategoryID], " & _
                "[tblCategories].[Description] FROM [tblCategories];"
            fMCombo6.ColumnCount = 2
            fMCombo6.ColumnWidths = "0cm;4.55cm"
            fMCombo6.BoundColumn = 1
            fRCombo6.DefaultValue = RCombo6
            fRCombo6.RowSource = "SELECT DISTINCTROW [tblCategories].[CategoryID], " & _
                "[tblCategories].[Description] FROM [tblCategories];"
            fRCombo6.ColumnCount = 2
            fRCombo6.ColumnWidths = "0cm;4.55cm"
            fRCombo6.BoundColumn = 1
        Case "Stage"
            Me.RecordSource = "tblStages"
            fMCombo6.DefaultValue = MCombo6
            fMCombo6.RowSource = "SELECT tblStages.StageID, tblStages.Description " & _
                "FROM tblStages ORDER BY tblStages.SortOrder;"
            fMCombo6.ColumnCount = 2
            fMCombo6.ColumnWidths = "0cm;4.55cm"
            fMCombo6.BoundColumn = 1
            fRCombo6.DefaultValue = RCombo6
            fRCombo6.RowSource = "SELECT tblStages.StageID, tblStages.Description " & _
                "FROM tblStages ORDER BY tblStages.SortOrder;"
            fRCombo6.ColumnCount = 2
            fRCombo6.ColumnWidths = "0cm;4.55cm"
            fRCombo6.BoundColumn = 1
        Case Else
    End Select
End Sub
'
'These are the link and unlink functions I used.
'The names of the various databases are retrieved at start-up time and stored
'in Global variables
'
Public Function LinkReplica()
    On Error GoTo LinkReplica_Err
    Dim tdf As TableDef
    Dim strTable As String
    Dim strNewConnect As String
    Set dbs = CurrentDb()
    Set rst = dbs.OpenRecordset("SELECT MSysObjects.Connect, MsysObjects.Database, " & _
        "MSysObjects.Name from MSysObjects " & _
        "WHERE MSysObjects.Type = " & IntAttachedTableType)
    rst.MoveLast
    If rst.RecordCount <> 0 Then
        rst.MoveFirst
        strNewConnect = ";DATABASE=" & strDataReplica
        While Not rst.EOF
            strTable = rst!Name
            Set tdf = dbs.CreateTableDef(strTable & "1")
            tdf.Connect = strNewConnect
            tdf.SourceTableName = strTable
            dbs.TableDefs.Append tdf
            Set tdf = Nothing
            rst.MoveNext
        Wend
    End If
    dbs.TableDefs.Refresh
    rst.Close
    Set rst = Nothing
    LinkReplica = True
    Set dbs = Nothing
    Exit Function
LinkReplica_Err:
    LinkReplica = False
    MsgBox "Replica not linked, Contact programmer"
End Function

Public Function UnLinkReplica()
    On Error GoTo UnLinkReplica_Err
    Dim tdf As TableDef
    Dim strTable As String
    Set dbs = CurrentDb()
    Set rst = dbs.OpenRecordset("SELECT MSysObjects.Connect, MsysObjects.Database, " & _
        "MSysObjects.Name from MSysObjects " & _
        "WHERE MSysObjects.Type = " & IntAttachedTableType)
    rst.MoveLast
    If rst.RecordCount <> 0 Then
        rst.MoveFirst
        While Not rst.EOF
            strTable = rst!Name
            If right(strTable, 1) = "1" Then
                dbs.TableDefs.Delete (strTable)
            End If
            rst.MoveNext
        Wend
    End If
    dbs.TableDefs.Refresh
    rst.Close
    Set rst = Nothing
    UnLinkReplica = True
    Set dbs = Nothing
    Exit Function
LinkReplica_Err:
    UnLinkReplica = False
    MsgBox "Replica not unlinked, Contact programmer"
End Function
'************** End Code ******************************