--- Soumis par Hans Karman  ---

Synchronisation sans replication.

   Quelques explications sont nécessaires. 

1. Le système utilise des nombres aléatoires "autonumber" pour éviter les possibilités de duplication de clé. Chaque enregistrement possède également un champ DateLastUpdated qui est assigné à  Now() lors de chaque changement dans l'enregistrement, à une précision de une seconde. La synchronisation repose donc sur deux conditions: si une clé n'est pas trouvée dans la table du Master, l'enregistrement du Replica est ajouté à la table du Master comme nouvel enregistrement; si la clé est trouvée et que DateLastChanged du Replica est la même que sur le Master, alors on ne fait rien avec l'enregistrement du Replica. Si les dates sont différentes, l'utilisateur voit les deux champs, du Master et du Replica, côte à côte, pour prendre une décision sur lequel conserver et lequel rejeter. Au cours de ce processus,  frmDifferences est éditable, et l'opérateur peut donc effectuer les changements appropriés avant d'accepter une ou l'autre des versions. 

2. Le formulaire frmDifferences est un formulaire générique de trois colonnes, la première étant l'étiquette du champ (pour être significative à l'utilisateur), la seconde est le contenu du Master, la troisième, celle du Replica. Si le champ est un Combo ou List box, la valeur est représentée par une zone de liste avec les valeurs choisies. 

3. Le système comporte trois étapes: 
    a) Lier les tables du Replica au Maître. Ceci crée des table en double avec un 1 ajouté à la fin du nom (mais un autre caractère peut être utilisé). 
    b) Traverse chaque table en utilisant l'algorithme précédant pour présenter à l'utilisateur les cas requérant une intervention. 
    c) Effacer les tables du Replica du Master. On peut maintenant se débarrasser du Replica pour le remplacer par le Master afin de repartir le processus à nouveau. 

    [Cette dernière étape peut également être automatisée, mais mon client ne désirait pas dépenser l'argent.] 

Vous pouvez ajouter le traitement d'erreur pour rendre le tout plus robuste, mais la situation actuelle était satisfaisante pour mon client.

Le code doit être adapté pour chaque cas. Ce n'est applicable que pour de petites applications seulement. Il fonctionne virtuellement sans overhead (ce qui n'est pas du tout le cas avec la replication standard) dans notre cas, puisqu'il n'utilise qu'une clé et un champ daté.

Il est possible, pour des enregistrement, de générer la même clé, ou d'être modifié exactement à la même seconde. Le risque est minimal et tolérable, dans notre cas.

Une synchronisation hebdomadaire prends moins de cinq minutes et l'utilisateur est en complet contrôle du processus.

'********* Code starts *********************************
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 ******************************