I used this back when the company I worked at had an incredibly slow file server so I made this, it relies on the tables having date time stamps

modCustomReplication

Option Compare Database
Option Explicit




Public Sub ReplicateTableFromServerDownToClient(strTableName As String, cn As ADODB.Connection, blnRetrieveArchive As Boolean)
    
    On Error GoTo errUnableToReplicateToClient
    
    '// Define a query which will retrieve all rows from the server database table
    Set rsServer = New ADODB.Recordset
    Set rsClient = New ADODB.Recordset
    If strTableName = "tblTechnicalLog" And blnRetrieveArchive = False Then
        strLookup = DLookup("[StatusID]", "tblStatus", "[StatusName]=" & Chr(39) & "Open" & Chr(39))
        strSQL = "SELECT * FROM tblTechnicalLog WHERE StatusID = " & Chr(39) & strLookup & Chr(39)
    ElseIf strTableName = "tblXrefLogManager" And blnRetrieveArchive = False Then
        strSQL = "SELECT t1.TechnicalLogID, t1.TechManagerID, t1.LeadTechManager " & _
                    "FROM tblXrefLogManager AS t1, tblTechnicalLog AS t2, tblStatus AS t3 " & _
                    "WHERE t1.TechnicalLogID = t2.TechnicalLogID AND t2.StatusID = t3.StatusID AND t3.StatusName = 'Open'"
    Else
        strSQL = "SELECT * FROM " & strTableName
    End If
    rsServer.Open strSQL, cn, adOpenStatic, adLockOptimistic '// adOpenDynamic
    rsClient.Open strSQL, CurrentProject.Connection, adOpenDynamic, adLockOptimistic
  
    '// Identify how many rows are in the server database table
    If rsServer.EOF = False Then
        rsServer.MoveLast
        lngNumberOfRows = rsServer.RecordCount
        rsServer.MoveFirst
    End If
  
    '// Dont attempt to replicate if the table is empty
    If lngNumberOfRows = 0 Then
        GoTo skipProcessing
    End If
  
    '// Empty the table on the client database
    DoCmd.SetWarnings False
    DoCmd.RunSQL ("DELETE FROM " & strTableName)
    DoCmd.SetWarnings True
    
    '// START : loop around all rows in the server database table
    For lngRowNumber = 0 To (lngNumberOfRows - 1)

    '// Create an empty row - later used to insert into the client database table
    rsClient.AddNew
  
    '// START : loop around all columns in the current row from the server database table
    For lngColumnNumber = 0 To (rsServer.Fields.Count - 1)
  
    '// Fill the column in the client database table with the contents of the column
    '// In the server database table
    If IsNull(rsServer.Fields(lngColumnNumber)) = False Then
        rsClient.Fields(lngColumnNumber) = rsServer.Fields(lngColumnNumber)
    End If
  
    '// END : loop around all columns in the current row from the server database table
    Next lngColumnNumber
  
    '// Insert the formatted row into the client database table
    rsClient.Update

    '// Get the next row from the server database table
    rsServer.MoveNext
  
    '// END : loop around all rows in the server database table
    Next lngRowNumber
    
    rsServer.Close
    rsClient.Close
    Set rsServer = Nothing
    Set rsClient = Nothing

Exit Sub

skipProcessing:

    '// Close recordsets
    Set rsClient = Nothing
    Set rsServer = Nothing
    cn.Close
    Set cn = Nothing
    
    Exit Sub
    
errUnableToReplicateToClient:

    MsgBox "Unexpected Error : " & Err.Number & vbNewLine & Err.description
    GoTo skipProcessing
    
End Sub




Public Sub ReplicateRowFromClientUpToServerDB(strTableName As String, strNameValuePair As Variant, cn As ADODB.Connection)
        
    '// Determine whether a row already exists with this primary key in the server database
    Set rsServer = New ADODB.Recordset
              
    '// Build SQL Statement
    strSQL = "SELECT * FROM " & strTableName
            
    For i = 0 To UBound(strNameValuePair)
    
    If strNameValuePair(i, 1) = "True" Or strNameValuePair(i, 1) = "False" Then
        '// Do nothing
    Else
        strNameValuePair(i, 1) = Chr(39) & strNameValuePair(i, 1) & Chr(39)
    End If
    
        If i = 0 Then
            strSQL = strSQL & " WHERE " & _
                                strNameValuePair(i, 0) & " = " & strNameValuePair(i, 1)
        Else
            strSQL = strSQL & " AND " & _
                                strNameValuePair(i, 0) & " = " & strNameValuePair(i, 1)
        
        End If
        
    Next i
            
    rsServer.Open strSQL, cn, adOpenDynamic, adLockOptimistic
    If rsServer.EOF = True Then
        blnRowAlreadyExists = False
    ElseIf rsServer.EOF = False And strTableName = "tblXrefLogManager" Then
        '// Delete related xref details
        strSQL = "DELETE * FROM " & strTableName & " WHERE TechnicalLogID = " & strNameValuePair(0, 1)
        cn.Execute strSQL
        blnRowAlreadyExists = False
    ElseIf strTableName = "tblXrefManagerTeam" Then
        '// Delete related xref details
        strSQL = "DELETE * FROM " & strTableName & " WHERE TechnicalLogID = " & strNameValuePair(2, 1)
        cn.Execute strSQL
        blnRowAlreadyExists = False
    Else
        blnRowAlreadyExists = True
    End If
    rsServer.Close
    Set rsServer = Nothing
  
    '// Build SQL Statement
    strSQL = "SELECT * FROM " & strTableName
            
    For i = 0 To UBound(strNameValuePair)
    
        If i = 0 Then
            strSQL = strSQL & " WHERE " & _
                                strNameValuePair(i, 0) & " = " & strNameValuePair(i, 1)
        Else
            strSQL = strSQL & " AND " & _
                                strNameValuePair(i, 0) & " = " & strNameValuePair(i, 1)
        
        End If
        
    Next i
    
    '// Open client database
    Set rsClient = New ADODB.Recordset
    rsClient.Open strSQL, CurrentProject.Connection, adOpenDynamic, adLockOptimistic
    '// Open server database
    Set rsServer = New ADODB.Recordset
    If blnRowAlreadyExists = True Then

        '// Build SQL Statement
        strSQL = "SELECT * FROM " & strTableName
                
        For i = 0 To UBound(strNameValuePair)
            
            If i = 0 Then
                strSQL = strSQL & " WHERE " & _
                                    strNameValuePair(i, 0) & " = " & strNameValuePair(i, 1)
            Else
                strSQL = strSQL & " AND " & _
                                    strNameValuePair(i, 0) & " = " & strNameValuePair(i, 1)
            
            End If
            
        Next i
        rsServer.Open strSQL, cn, adOpenDynamic, adLockOptimistic
    
    Else
        strSQL = "SELECT * FROM " & strTableName
        rsServer.Open strSQL, cn, adOpenDynamic, adLockOptimistic
    End If
        
    '// If the row doesn't already exists then create a new record in the recordset
    If blnRowAlreadyExists = False Then
        rsServer.AddNew
    End If
        
    '// Format all of the columns in the row
    For lngColumn = 0 To (rsClient.Fields.Count - 1)
        rsServer.Fields(lngColumn) = rsClient.Fields(lngColumn)
    Next lngColumn
       
    '// Insert/update the row into the server database table
    rsServer.Update
    
    '// Close the client database
    rsClient.Close
    Set rsClient = Nothing
    
    '// Close the server database
    rsServer.Close
    Set rsServer = Nothing
    
End Sub