Option Compare Database
Option Explicit

Sub Test()
   On Error GoTo EXCEPT
    
    Call DropTable
    Call CreateTable(NoKey:=False)   'создаем таблицу с первичным ключом
'    Call CreateTable(NoKey:=True) 'создаем таблицу без первичного ключа
    Call PopulateTable(1)
    Call PopulateTable(2) 'по идее должна добавиться 1 запись в таблицу с ключом "4", но не добавляется
    Debug.Print CurrentProject.Connection.Execute("SELECT n FROM d", adCmdText).GetString(, , , ";")
    'смотрим, что получилось
    Call ClearTable
EXIT_HERE:
   Exit Sub

EXCEPT:

    Select Case Err.Number
        Case -2147217865 'таблица не существет
            Resume Next
        Case -2147217900  'таблица существует
            Resume Next
        Case Else
       MsgBox "Произошла ошибка " & Err.Number & vbNewLine & " (" & Err.Description & ") "
    End Select
    Resume EXIT_HERE

End Sub

Sub PopulateTable(ByVal n As Integer)
    Dim SQL As String, rst As ADODB.Recordset, i As Integer
   On Error GoTo EXCEPT

    SQL = "SELECT n FROM d WHERE 1=0"
    Set rst = New ADODB.Recordset
    With rst
        .Open SQL, CurrentProject.Connection, adOpenForwardOnly, adLockOptimistic
        For i = n To n + 2
            .AddNew "n", i 'Err.number -2147217887 возникает даже если такого ключа еще нет
            'в случае, если она уже возникала на предыдущем шаге цикла. (Но Resume next сбрасывает ошибку (обязан сбрасывать))
        Next i
        .Update
        
    End With
EXIT_HERE:
    On Error Resume Next
    rst.Close
    Set rst = Nothing
   Exit Sub

EXCEPT:

    Select Case Err.Number
        Case -2147217887 'повторяющиеся записи
           Resume Next
        Case Else
           MsgBox "Произошла ошибка " & Err.Number & vbNewLine & " (" & Err.Description & ") "
    End Select
    Resume EXIT_HERE
End Sub

Sub CreateTable(Optional NoKey As Boolean = False)
    Dim SQL As String
    If NoKey Then
        SQL = "CREATE TABLE d (n INTEGER NOT NULL)"
    Else
        SQL = "CREATE TABLE [d] ([n] INTEGER NOT NULL, CONSTRAINT d_pk PRIMARY KEY ([N]) )"
    End If
    CurrentProject.Connection.Execute SQL, , adCmdText + adExecuteNoRecords
End Sub

Sub DropTable()
    Dim SQL As String
    SQL = "DROP TABLE [d]"
    CurrentProject.Connection.Execute SQL, , adCmdText + adExecuteNoRecords
End Sub

Sub ClearTable()
    Dim SQL As String
    SQL = "DELETE * FROM d"
    CurrentProject.Connection.Execute SQL, , adCmdText + adExecuteNoRecords
End Sub