Доступ не выдает ошибку, если в таблицу вставлены повторяющиеся записи

Question

Я использую следующий код для импорта электронной таблицы Excel в базу данных доступа:

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

Первый столбец в моей базе данных - это первичный ключ. Я не получаю никаких ошибок, если вставлены данные с одинаковыми первичными ключами. Я хотел бы получить ошибки однако. Как вызвать ошибку, если в электронной таблице содержатся повторяющиеся строки?

Answer 1

Вместо удобного метода TransferSpreadsheet рассмотрите возможность использования прямого запроса SQL к книге Excel (который допустим в Access SQL) для захвата ошибки исключения, как показано ниже. Поскольку MS Access является одновременно GUI приложением и ядром базы данных, вам необходимо включить две разные ссылки. Настройте под оператором SQL фактические столбцы, имена и пути.

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