Question

I created an Access database which I want to distribute to a small group. While I can always export the tables in excel and merge them/append data there, is there a way to sync the databases, maybe by using VBA?

To expound further, in one form in the database application, a sync button may exist, and onclick, a dialog box may open to look for the accdb to sync with. What ensues is that the VBA will “sync” the table (which of course is of the same structure) in question between the two accdbs.

Is this possible? Insights will be good. Thank you!

Answer 1

Yes, it is perfectly possible. Here are some notes on comparing two DBs and logging changes.

The procedure requires the following at the top of the module:

Dim strFileNew As String 
Dim strFileOld As String 
Dim strLog As String
Dim dbOld As Database

The variables might contain:

strLog = "log.txt"
strFileNew = "z:\docs\dbNew.mdb"
strFileOld = "z:\docs\dbOld.mdb"
Set dbOld = OpenDatabase(strFileOld)

Then the comparison:

Sub LogCompareDB(db As Database)
''References : Windows Script Host Object Model
''           This is set by default for a number of versions
''           : Microsoft DAO x.x Object Library
''           For 2010, the DAO library is called 
''           :Microsoft Office 12.0 Access Database Engine Object Library

Dim tdf As TableDef
Dim rs0 As DAO.Recordset
Dim rs1 As DAO.Recordset
Dim fld As DAO.Field
Dim idx As Index
Dim idxPrimary  As Index
Dim strIndexList As String
Dim strIndex As String
Dim strID As String
Dim strSQL As String
Dim strChanged As String
Dim blnNew As Boolean
Dim fs As New FileSystemObject
Dim ts As TextStream

    Set ts = fs.CreateTextFile(strLog, True)

    ''For each table in the old database
    ''(It would probably be a good idea to check the
    ''new database for added tables)
    For Each tdf In db.TableDefs
        '' Skip system tables
        If Left(tdf.Name, 4) <> "MSys" Then
            strIndex = vbNullString
            Set idxPrimary = Nothing
            strIndexList = vbNullString

            ''Get the primary index and index fields
            For Each idx In tdf.Indexes
                If idx.Primary = True Then
                    Set idxPrimary = idx
                    For Each fld In idx.Fields
                        strIndex = strIndex & " AND t0.[" & fld.Name _
                            & "] = t1.[" & fld.Name & "]"
                        strIndexList = strIndexList & "," & fld.Name
                    Next
                    strIndex = Mid(strIndex, 5)
                End If
            Next

            ''There is no basis for comparison if there is no index.
            ''A unique index would also be a possibility, but hey, let's
            ''not go over the top :)
            If strIndex > vbNullString Then

                ''Select all records from the table for both databases
                strSQL = "SELECT * FROM [;DATABASE=" & strFileNew & "].[" _
                    & tdf.Name & "] As t0 LEFT JOIN [" _
                    & tdf.Name & "] As t1 ON " & strIndex

                Set rs0 = db.OpenRecordset(strSQL)

                ''A convenient list of fields from the old database
                ''It would probably be a good idea to check the
                ''new database for added fields.

                strSQL = "SELECT * FROM [;DATABASE=" & strFileOld & "].[" _
                    & tdf.Name & "] As t0 WHERE 1=2"

                Set rs1 = db.OpenRecordset(strSQL)

                Do While Not rs0.EOF
                    strID = vbNullString
                    blnNew = False

                    ''If the index fields are null, then it is a new record
                    For Each fld In idxPrimary.Fields
                        strID = strID & fld.Name & ": " & rs0("[t0." & fld.Name & "]") & vbCrLf

                        If IsNull(rs0("[t1." & fld.Name & "]")) Then
                            blnNew = True
                        End If
                    Next

                    If blnNew Then
                        ''Write to log
                        ts.WriteLine "NEW RECORD " & strID & vbCrLf
                    Else
                        ''Not a new record, so is it a changed record?
                        strChanged = vbNullString

                        For Each fld In rs1.Fields
                            ''No need to check index fields, because they are equal
                            If InStr(strIndexList, fld.Name) = 0 Then

                                ''Add null string for purposes of comparison                                 ''trailing
                                If "" & rs0("[t0." & fld.Name & "]") <> "" & rs0("[t1." & fld.Name & "]") Then
                                    strChanged = strChanged & vbCrLf _
                                        & fld.Name & "  Is: " & Trim(rs0("[t0." & fld.Name & "]")) _
                                        & "  Was: " & Trim(rs0("[t1." & fld.Name & "]"))
                                End If
                            End If
                        Next

                        If strChanged <> vbNullString Then
                            ''Write to log
                            ts.WriteLine "CHANGED RECORD " & strID
                            ts.WriteLine strChanged & vbCrLf
                        End If
                    End If

                    rs0.MoveNext
                Loop
            Else
                ts.WriteLine "NO PRIMARY INDEX " & tdf.Name & vbCrLf
            End If
        End If
    Next

   ts.Close
   FollowHyperlink strLog
End Sub