One way Synchronize 2 Access Tables with VBA ADODB

Question

I am synchronizing two MS-Access databases. One of them on a network drive, the other one on the local machine. (For testing purposes both in the same directory)

The Databases both contain a table named "tblCheckup" with an essential ID Field called "checkGUID"

I am aware that this will probably fail if there are no records in either of the Tables but this is of no concern.

Since i am fairly new to ADODB and MS Access i am looking for any performance issues with larger scales. Expected table size growth is around 3000 entries per year.

I am thankful for any hints concerning possible runtime errors, possible bottlenecks in speed and performance issues in larger scales as stated above. Also i am not really sure if i used the best CursorType and LockType.

Private Sub SyncToServerTest()
Dim rsExists As Boolean
Dim lngCount As Long
Dim connLokal As ADODB.Connection
Dim connServer As ADODB.Connection
Dim dataLokal As ADODB.Recordset
Dim dataServer As ADODB.Recordset
Set connLokal = New ADODB.Connection
Set connServer = New ADODB.Connection
Set dataLokal = New ADODB.Recordset
Set dataServer = New ADODB.Recordset
connLokal.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\AccessSyncTest\Lokal.accdb;Persist Security Info=False;"
connLokal.Open
connServer.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\AccessSyncTest\Server.accdb;Persist Security Info=False;"
connServer.Open
With dataLokal
 .ActiveConnection = connLokal
 .Source = "tblCheckup"
 .LockType = adLockPessimistic
 .CursorType = adOpenForwardOnly
 .Open
 
 If .EOF Then
 Debug.Print "No entries in Local Table"
 Exit Sub
 Else
 .MoveFirst
 End If
 
End With
With dataServer
 .ActiveConnection = connServer
 .Source = "tblCheckup"
 .LockType = adLockPessimistic
 .CursorType = adOpenForwardOnly
 .Open
 
 If .EOF Then
 Debug.Print "No entries in Server Table"
 Exit Sub
 Else
 .MoveFirst
 End If
End With
Do Until dataLokal.EOF
 rsExists = False
 Do Until dataServer.EOF Or rsExists
 If dataLokal.Fields("checkGUID").Value = dataServer.Fields("checkGUID").Value Then
 rsExists = True
 End If
 dataServer.MoveNext
 Loop
 If Not rsExists Then
 dataServer.AddNew
 For lngCount = 0 To dataLokal.Fields.Count - 1
 dataServer.Fields(dataLokal.Fields(lngCount).Name).Value = dataLokal.Fields(lngCount).Value
 Next lngCount
 Debug.Print dataLokal.Fields("checkGUID").Value & " was added"
 
 End If
 dataServer.MoveFirst
 dataLokal.MoveNext
Loop
dataLokal.Close
dataServer.Close
Set dataLokal = Nothing
Set dataServer = Nothing
Set connLokal = Nothing
Set connServer = Nothing 
End Sub

Answer 1

Using nested while loops can easily turn into a time-sink. Rather, save the missing checkGUID values to an array using SQL, and only loop once to save time (and debugging headaches):

Dim r As Object, sqlSTR As String, i As Long, guids As Variant
' only grab checkGUID values which exist in dataLocal but not dataServer
sqlSTR = "SELECT dataLokal.checkGUID" _
& " FROM dataLokal LEFT JOIN dataServer ON dataLokal.checkGUID = dataServer.checkGUID " _
& " WHERE dataServer.checkGUID Is Null"
Set r = CurrentDb.OpenRecordset(sqlSTR, adOpenDynamic)
With r
 .MoveLast
 .MoveFirst
 guids = .GetRows(.RecordCount)
End With
r.Close
Set r = Nothing
For i = 0 To UBound(guids, 2)
 updateGUID = guids(0,i)
 ' ... table updates by updateGUID value'
Next i

• MZiegaus: Thats clever, thank you. Exactly what i was hoping for. I feel like learning more SQL is the way to improve here. COuld you explain why you use adOpenDynamic? I thought i could use Forwardonly and improve performance this way.