VBA Access Обработчик ошибок

[Ethex]

Доброго времени суток

Для процедуры импорта данных из Excel в Access нужно сделать обработчик ошибок. В данный момент под ошибкой подразумевается последствие попадания в столбец таблицы символа, непереваримого для поля типа FLOAT (пока так, иные возможные ошибки пока неизвестны).

Требуется, чтобы, наткнувшись на строку с такой ошибкой, создалась табличка, куда будет импортирован номер этой строки (номера строк содержатся в столбце А). При этом, импорт данных в таблицу должен продолжаться.

Public Sub Ex2Acc() 
' Dim sheet As Excel.Worksheet
Dim book As Excel.Workbook
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim rstb As String
' Dim rstEr As DAO.Recordset
Dim appXl As Excel.Application
Dim wrksheet As Excel.Worksheet
Dim i As Long

rstb = Forms![Form1].[Поле13].Value

Set appXl = CreateObject("Excel.Application")
Set book = appXl.Workbooks.Open(Forms![Form1].[Поле3].Value)
Set dbs = CurrentDb
Set rst = CurrentDb.OpenRecordset(rstb)
Set wrksheet = book.Sheets(1)

  With book.Sheets(1)
  For i = 5 To 100 '.Rows.Count
  If InStr(1, wrksheet.Cells(i, "H").Value, "ns") > 0 Then
  With rst
     .AddNew
     On Error GoTo ErNumber
     ![OBSN] = wrksheet.Cells(i, "B")
     ![NAIM] = wrksheet.Cells(i, "C")
     ![ED_IZM] = wrksheet.Cells(i, "D")
     ![BRUTTO] = wrksheet.Cells(i, "E")
     ![C_BASE] = wrksheet.Cells(i, "F")
     ![CLASS_GR] = wrksheet.Cells(i, "G")
     ![COD_UZ] = wrksheet.Cells(i, "H")
     ![C_OPT] = wrksheet.Cells(i, "I")
     ![C_SMET] = wrksheet.Cells(i, "J")
     ![IND] = wrksheet.Cells(i, "K")
     .Update
  End With
  End If
   Next
   End With
   rst.Close: Set rst = Nothing
   dbs.Close: Set rst = Nothing
   book.Close: Set book = Nothing
   appXl.Quit: Set appXl = Nothing
 Err.Count
MsgBox "Завершено"
   Exit Sub

ErNumber: ' строка обработки
   CurrentDb.Execute "CREATE TABLE Errors(RowNumbers VARCHAR)"
   Set rst = CurrentDb.OpenRecordset("Errors")
   With wrksheet
   With rst
   .AddNew
   ![RowNumbers] = wrksheet.Cells(i, "A")
   .Update
   End With
   End With
   Resume Next
   MsgBox "Найдены ошибки в строках (см. таблицу Errors)"
   
End Sub

Вот чем пока располагаю
Когда выполняю процедуру, она прерывается ошибкой 3010 и сообщает, что таблица Errors уже существует; подчёркнут запрос на создание таблицы. Импорт данных приостановлен на строке с ошибкой. Таблица Errors создана, в ней положенный номер строки.
Похоже, программа пытается создать её повторно...

Подскажите пожалуйста, как вылечить?

[Aleksandr H.]

Один из вариантов

ErNumber: ' строка обработки
	If DCount("[Name]", "MSysObjects", "[Name] = 'Errors'") <> 0 Then
		CurrentDb.Execute "CREATE TABLE Errors(RowNumbers VARCHAR)"
	end if
   Set rst = CurrentDb.OpenRecordset("Errors")
   With wrksheet
   With rst
   .AddNew
   ![RowNumbers] = wrksheet.Cells(i, "A")
   .Update
   End With
   End With
   Resume Next
   MsgBox "Найдены ошибки в строках (см. таблицу Errors)"

[Ethex]

Один из вариантов

Не сработал. Та же ошибка в той же строке

[Aleksandr H.]

Делитесь xlsx и mdb. Будем посмотреть

[Ethex]

Вот. Эксельник, естественно, кастрирован
В строке 95 нехороший символ

[Aleksandr H.]

А так?

Public Sub Ex2Acc()    ' Импорт данных
' Dim sheet As Excel.Worksheet
    Dim book As Excel.Workbook
    Dim dbs As DAO.Database
    Dim rst As DAO.Recordset
    Dim rstE As DAO.Recordset
    Dim rstb As String
    ' Dim rstEr As DAO.Recordset
    Dim appXl As Excel.Application
    Dim wrksheet As Excel.Worksheet
    Dim i As Long

    rstb = Forms![Form1].[Поле13].Value

    Set appXl = CreateObject("Excel.Application")
    Set book = appXl.Workbooks.Open(Forms![Form1].[Поле3].Value)
    Set dbs = CurrentDb
    Set rst = CurrentDb.OpenRecordset(rstb)
    Set wrksheet = book.Sheets(1)
    With book.Sheets(1)
        i = 5
        Do While i < 120
            'For i = 5 To 100    '.Rows.Count
            If InStr(1, wrksheet.Cells(i, "H").Value, "ns") > 0 Then
                With rst
                    On Error GoTo ErNumber
                    .AddNew
                    ![obsn] = wrksheet.Cells(i, "B")
                    ![NAIM] = wrksheet.Cells(i, "C")
                    ![ED_IZM] = wrksheet.Cells(i, "D")
                    ![BRUTTO] = wrksheet.Cells(i, "E")
                    ![C_BASE] = wrksheet.Cells(i, "F")
                    ![CLASS_GR] = wrksheet.Cells(i, "G")
                    ![COD_UZ] = wrksheet.Cells(i, "H")
                    ![C_OPT] = wrksheet.Cells(i, "I")
                    ![C_SMET] = wrksheet.Cells(i, "J")
                    ![IND] = wrksheet.Cells(i, "K")
                    .Update
                    On Error GoTo 0
                End With
            End If
WhileEnd:
            i = i + 1
        Loop
    End With
    rst.Close: Set rst = Nothing
    dbs.Close: Set rst = Nothing
    book.Close: Set book = Nothing
    appXl.Quit: Set appXl = Nothing
    'Err.Count
    MsgBox "Завершено"
    If DCount("[Name]", "MSysObjects", "[Name] = 'Errors'") > 0 Then
        MsgBox "Найдены ошибки в строках(см. таблицу Errors)"
    End If
    Exit Sub

ErNumber:
    If DCount("[Name]", "MSysObjects", "[Name] = 'Errors'") = 0 Then
        DoCmd.RunSQL "CREATE TABLE [Errors] (RowNumbers VARCHAR)"
    End If
    Set rstE = CurrentDb.OpenRecordset("Errors")
    With wrksheet
        With rstE
            .AddNew
            ![RowNumbers] = wrksheet.Cells(i, "A")
            .Update
        End With
    End With
    GoTo WhileEnd
End Sub

[Ethex]

Aleksandr H., поздно увидел. Сегодня уже не успею, завтра утром попробую. Единственное, поспрашиваю немного.
1) Зачем замена For на Do While?
2) Для чего служит вот эта часть?

WhileEnd:
            i = i + 1

3) Необходим ли второй рекордсет? Один, впринципе, добавлял значение в Errors, правда, не знаю как бы вёл он себя далее, если бы ошибки 3010 не возникло...
4) Стыдно спрашивать, но немогли бы Вы объяснить мне вот эти условия?

If DCount("[Name]", "MSysObjects", "[Name] = 'Errors'") > 0 Then

If DCount("[Name]", "MSysObjects", "[Name] = 'Errors'") = 0 Then

Искал о них в нете, что-то находил, но так и не разобрался
Приношу извинения за повышенный градус незнания

[Aleksandr H.]

1. Была какая-то мысля где шаг должен был быть не 1. Но можете оставить For
2. После обработки ошибки код должен вернуться для обработки следующих строк. Как это сделать?
3. Необходим. В первом храните Таблицу1, при ошибке в етот рекордсет пишете таблицу Еррор. После внесения данных в Еррор, ведь надо вернуться к внесению данных в Таблицу. А как если в рекордсете таблица Еррор? Как вариант, перенести в начало цикла строку

Set rst = CurrentDb.OpenRecordset(rstb)

4. в кратце, то

Если в объектах базы данных, если больше 0 объектов с именем = Еррор, то

Если в объектах базы данных, нет объектов с именем = Еррор, то

[Ethex]

Aleksandr H., попробовал сделать вариантик, несколько более приближённый к тому, что в первом посте

...
Dim rstEr As DAO.Recordset
...
With book.Sheets(1)
  For i = 5 To .Rows.Count
  If InStr(1, wrksheet.Cells(i, "H").Value, "ns") > 0 Then
  With rst
     .AddNew
     On Error GoTo ErNumber
     ![OBSN] = wrksheet.Cells(i, "B")
     ![NAIM] = wrksheet.Cells(i, "C")
     ![ED_IZM] = wrksheet.Cells(i, "D")
     ![BRUTTO] = wrksheet.Cells(i, "E")
     ![C_BASE] = wrksheet.Cells(i, "F")
     ![CLASS_GR] = wrksheet.Cells(i, "G")
     ![COD_UZ] = wrksheet.Cells(i, "H")
     ![C_OPT] = wrksheet.Cells(i, "I")
     ![C_SMET] = wrksheet.Cells(i, "J")
     ![IND] = wrksheet.Cells(i, "K")
     .Update
     On Error GoTo 0
  End With
  End If
   Next
   End With
   rst.Close: Set rst = Nothing
   dbs.Close: Set rst = Nothing
   book.Close: Set book = Nothing
   appXl.Quit: Set appXl = Nothing

   MsgBox "Завершено"

   If DCount("[Name]", "MsysObjects", "[Name] = 'Errors'") > 0 Then
   MsgBox "Найдены ошибки в строках(см. таблицу Errors)"
   End If
   Exit Sub

ErNumber:
   If DCount("[Name]", "MSysObjects", "[Name] = 'Errors'") = 0 Then
   CurrentDb.Execute "CREATE TABLE Errors(RowNumbers VARCHAR)"
   End If
   Set rstEr = CurrentDb.OpenRecordset("Errors")
   With wrksheet
   With rstEr
   .AddNew
   ![RowNumbers] = wrksheet.Cells(i, "A")
   .Update
   End With
   End With
   Resume Next
End Sub

Вполне себе дал положительный результат
Потом попробовал запустить процедуру с одним ркордсетом. Процедура выполнялась, ошибок не выдавало, но устал ждать пока она выполнялась - прождал около часа с лишним, устал и снял задачу. Это при том, что ошибок, для которых делался обработчик в файле было всего 5 (если будет настроение, снижу колличество обрабатываемых строк до ста и посмотрю что из этого выйдет)

Спасибо вам за помощь в очередной раз. В данном случае, главным образом за условие. Сам бы, наверное, нескоро бы докопался до него

P.S. Вопрос номер 2, собственно, подразумевал использование Resume Next