CODEWITHSUNDEEP
excelvbams-access
MGP
MGP

Reputation: 2551

Access not throwing error if duplicate records are inserted into table

I'm using the following code to import a Excel spreadsheet into a access Database:

Dim appAccess As Access.Application
Set appAccess = CreateObject("Access.Application")
appAccess.OpenCurrentDatabase "path_to_db"
appAccess.DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12Xml, "my_db_table_name", "path_to_excel_file", hasFieldNames, acImportRange

The first Column in my Database is the Primary-Key. I don't get any errors, if data with the same Primary-Keys are inserted. I would like to get errors however. How can I force an error if duplicate rows are contained in the spreadsheet?

Upvotes: 2

Views: 445

Answers (1)

Parfait
Parfait

Reputation: 107567

Instead of the convenience method, TransferSpreadsheet, consider using a direct SQL query to Excel workbook (which is allowable in Access SQL) to capture the exception error as shown below. Because MS Access is both a GUI application and database engine, you would need to enable two different references. Adjust below SQL statement with actual columns, names, and paths.

Public Sub CaptureExceptions()
On Error GoTo ErrHandle
    Dim strSQL As String
    Dim db As DAO.Database                   ' ENABLE Microsoft Office x.x Access database engine object library
    Dim appAccess As Access.Application      ' ENABLE Microsoft Access x.x Object Library

    Set appAccess = CreateObject("Access.Application")

    appAccess.OpenCurrentDatabase "C:\Path\To\Access\Database.accdb"

    strSQL = "INSERT INTO my_db_table_name (Col1, Col2, Col3, ...)" _
              & " SELECT Col1, Col2, Col3, ..." _
              & " FROM [Excel 12.0 Xml; HDR = Yes;Database=C:\Path\To\Excel\Workbook.xlsx].[SheetName$];"

    Set db = appAccess.CurrentDb()
    db.Execute strSQL, dbFailOnError

    appAccess.CloseCurrentDatabase

ExitHandle:
    Set db = Nothing: Set appAccess = Nothing
    Exit Sub

ErrHandle:
    MsgBox Err.Number & ": " & Err.Description, vbCritical, "RUNTIME ERROR"
    Resume ExitHandle
End Sub

Exception Message

Upvotes: 2

Related Questions