Updating Access table via Excel VBA. Need to handle duplicate entry error in Primary Key field

[sgowri7]

Hi there,

I am trying to update an existing database with data which is collected weekly. Eveyrthing works fine when there are no duplicte entries (i.e. one that I am currently updating is already existing in the database).

However, whenever there are duplicate entries, I am getting error message "the changes you are .... duplicate values in index, primary.... etc."

How do I handle this error and continue with updating the rest of the rows that i have in excel?

This is the code that I use

Sub GetExcelDataToAccess_ADO()
' exports data from active worksheet to a table in an Access database
Dim cn As ADODB.Connection, rs As ADODB.Recordset, i As Long, lastrow As Long
' connect to the Access database
Set cn = New ADODB.Connection
'define and open a recordset from the specified database path and database table name. Change it to suit your need.

cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & " Data Source=E:\Mod.mdb;"

Set rs = New ADODB.Recordset
rs.Open "IntAuditData_Backup", cn, adOpenKeyset, adLockOptimistic, adCmdTable

lastrow = ActiveSheet.UsedRange.Rows.Count
For i = 2 To lastrow ' start from row 2 in the worksheet
With rs
.AddNew ' create a new record
' add values to each field in the record
.Fields("DATE") = Range("A" & i).Value
.Fields("Job #") = Range("B" & i).Value
.Fields("DQS ID") = Range("C" & i).Value
.Fields("AuditType") = Range("D" & i).Value
.Fields("Auditor") = Range("E" & i).Value
.Fields("Set") = Range("F" & i).Value
.Fields("Loaded?") = Range("G" & i).Value
.Fields("Duplicate?") = Range("H" & i).Value
.Fields("AudMonth") = Range("I" & i).Value
.Fields("AuditedFor") = Range("J" & i).Value
.Update
End With

Next i
' close the connection
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
End Sub

 

[b.downey]

You may want to trap the error and then cancel the "AddNew" method and move onto the next wxcel record

For Example

Sub GetExcelDataToAccess_ADO()
' exports data from active worksheet to a table in an Access database
    Dim cn As ADODB.Connection, rs As ADODB.Recordset, i As Long, lastrow As Long
    ' connect to the Access database
    Set cn = New ADODB.Connection
    'define and open a recordset from the specified database path and database table name. Change it to suit your need.
    
    cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & " Data Source=E:\Mod.mdb;"
    
    Set rs = New ADODB.Recordset
    rs.Open "IntAuditData_Backup", cn, adOpenKeyset, adLockOptimistic, adCmdTable
    
    lastrow = ActiveSheet.UsedRange.Rows.Count
    
    On Error GoTo errHandle
    
    For i = 2 To lastrow ' start from row 2 in the worksheet
        With rs
            .Addnew ' create a new record
            ' add values to each field in the record
            .Fields("DATE") = Range("A" & i).Value
            .Fields("Job #") = Range("B" & i).Value
            .Fields("DQS ID") = Range("C" & i).Value
            .Fields("AuditType") = Range("D" & i).Value
            .Fields("Auditor") = Range("E" & i).Value
            .Fields("Set") = Range("F" & i).Value
            .Fields("Loaded?") = Range("G" & i).Value
            .Fields("Duplicate?") = Range("H" & i).Value
            .Fields("AudMonth") = Range("I" & i).Value
            .Fields("AuditedFor") = Range("J" & i).Value
            .Update
        End With
    
    Next i
    
    
    ' close the connection
    rs.Close
    Set rs = Nothing
    cn.Close
    Set cn = Nothing
    Exit Sub
    
errHandle:
    Select Case Err.Number
        Case 3022   'The changes you requested to the table were not successful because they would create duplicate values in the index, primary key, or relationship.
        rs.cancelupdate
        Resume Next
    End Select
End Sub

 

[sgowri7]

That seems to work. Thank you, Downey.

 

[b.downey]

NP. Thanks for the feed back