if duplicate update, else add records (from excel to access)

I have a command button in excel to insert the records to access table. Here's my vba code.

Option Explicit    Sub AddRecordsIntoAccessTable()        Dim accessFile  As String      Dim accessTable As String      Dim sht         As Worksheet      Dim lastRow     As Long      Dim lastColumn  As Integer      Dim con         As Object      Dim rs          As Object      Dim sql         As String      Dim i           As Long      Dim j           As Integer                    'Disable the screen flickering.      Application.ScreenUpdating = False            'Specify the file path of the accdb file. You can also use the full path of the file like this:      'AccessFile = "C:\Users\Christos\Desktop\Sample.accdb"      accessFile = ThisWorkbook.Path & "\" & "Database daily activity.accdb"                 'Ensure that the Access file exists.      If FileExists(accessFile) = False Then          MsgBox "The Access file doesn't exist!", vbCritical, "Invalid Access file path"          Exit Sub      End If            'Set the name of the table you want to add the data.      accessTable = "DAILY_ACTIVITY"                        'Set the worksheet that contains the data.      On Error Resume Next      Set sht = ThisWorkbook.Sheets("Daily Activity")      If Err.Number <> 0 Then          MsgBox "The given worksheet does not exist!", vbExclamation, "Invalid Sheet Name"          Exit Sub      End If      Err.Clear                'Find the last row and last column in the given worksheet.      With sht          lastRow = .Cells(.Rows.Count, "B").End(xlUp).Row          lastColumn = .Cells(1, .Columns.Count).End(xlToLeft).Column      End With            'Check if there are data in the worksheet.      If lastRow < 2 Or lastColumn < 1 Then          MsgBox "There are no data in the given worksheet!", vbCritical, "Empty Data"          Exit Sub      End If                'Create the ADODB connection object.      Set con = CreateObject("ADODB.connection")            'Check if the object was created.      If Err.Number <> 0 Then          MsgBox "The connection was not created!", vbCritical, "Connection Error"          Exit Sub      End If      Err.Clear            'Open the connection.      con.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & accessFile            'Create the SQL statement to retrieve the table data (the entire table).      sql = "SELECT * FROM " & accessTable            'Create the ADODB recordset object.      Set rs = CreateObject("ADODB.Recordset")            'Check if the object was created.      If Err.Number <> 0 Then          Set rs = Nothing          Set con = Nothing          MsgBox "The recordset was not created!", vbCritical, "Recordset Error"          Exit Sub      End If      Err.Clear                     'Set the necessary recordset properties.      rs.CursorType = 1   'adOpenKeyset on early binding      rs.LockType = 3     'adLockOptimistic on early binding                'Open the recordset.      rs.Open sql, con            'Add the records from Excel to Access by looping through the rows and columns of the given worksheet.      'Here the headers are in the row 1 and they are identical to the Access table headers.      'This is the reason why, for example, there are no spaces in the headers of the sample worksheet.      Application.ScreenUpdating = True      On Error GoTo 0      For i = 2 To lastRow          rs.AddNew          For j = 1 To lastColumn              'This is how it will look like the first time (i = 2, j = 1):              rs(sht.Cells(1, j).Value) = sht.Cells(i, j).Value          Next j          rs.Update      Next i                'Close the recordet and the connection.      rs.Close      con.Close            'Release the objects.      Set rs = Nothing      Set con = Nothing            'Re-enable the screen.      Application.ScreenUpdating = True        'Inform the user that the macro was executed successfully.      MsgBox lastRow - 1 & " rows were successfully added into the '" & accessTable & "' table!", vbInformation, "Done"        End Sub    Function FileExists(FilePath As String) As Boolean         '--------------------------------------------------      'Checks if a file exists (using the Dir function).      '--------------------------------------------------         On Error Resume Next      If Len(FilePath) > 0 Then          If Not Dir(FilePath, vbDirectory) = vbNullString Then FileExists = True      End If      On Error GoTo 0     End Function  

This code can only add new records, and it will be error if there is duplicate.

How do I fix the code with the condition:

1. Update existing access table for the records that is duplicate.
2. Add the records that is non duplicate

https://stackoverflow.com/questions/65867114/if-duplicate-update-else-add-records-from-excel-to-access January 24, 2021 at 12:22PM