Когда ошибка появляется снова, обработка ошибок не работает - PullRequest
0 голосов
/ 12 февраля 2019

Логика:

  • Пользователь.Нажимает кнопку;
  • Код.Создает набор записей «rstStud» (студенты) и «rstGroupStud» (группы студентов);
  • Код.Цикл.Перечисляет "rstStud";
    • Код.Добавить запись в "rstGroupStud";
    • Код.Если запись существует, перейдите к следующей записи в цикле;
    • Код.Если запись новая, добавьте запись в "rstGroupStud";
      Суть: одним нажатием кнопки - добавить одну уникальную запись.

Проблема.
Когда цикл проходит!StudentName = "Имя ученика 2" в строке ".Update" Я получаю ошибку.
Ошибка:
"Не удалось внести изменения из-за повторяющихся значений в индексе,первичный ключ или отношения. Измените данные в одном или нескольких полях, содержащих повторяющиеся значения, удалите индекс или переопределите его, разрешив повторяющиеся значения, и повторите попытку. "

Другими словами, в первый разОбработчик ошибок работает нормально, и когда я перезапускаю, я получаю ошибку.

Вопрос.
Как заставить код работать в соответствии с описанной логикой?

Private Sub btnAddRecord_Click()
    Dim nameStud As String

    Dim rstStud As DAO.Recordset   '
    Dim rstGroupStud As DAO.Recordset '

    Set rstStud = CurrentDb.OpenRecordset("tbl_02_Students", dbOpenSnapshot)  '
    Set rstGroupStud = CurrentDb.OpenRecordset("tbl_03_GruopsStudents", dbOpenDynaset)  '

    ' *** rstStud
    With rstStud
        Do Until .EOF = True
            nameStud = !nameStud

            On Error GoTo errend
            ' *** rstGroupStud
            With rstGroupStud
                .AddNew

                !idGroup = Me.id_GroupFrm
                !nameStud = nameStud
                ' nameStud
                .Update
            End With
            rstGroupStud.Close
            Me.frm_03_GruopsStudents_tbl.Requery

            Exit Sub
errend:
            .MoveNext
        Loop
    End With

    On Error Resume Next
    rstStud.Close
    Set rstStud = Nothing
End Sub

enter image description here enter image description here enter image description here enter image description here

Update_1
Файл - ссылка

Ответы [ 3 ]

0 голосов
/ 12 февраля 2019

Не делай этого в VBA.Сделайте это в запросе вместо этого.

Например, вы можете сделать это следующим образом:

Создать запрос с именем qryAssignStudentsToGroup:

PARAMETERS id_GroupFrm INT;
INSERT INTO tbl_03_GruopsStudents (idGroup, nameStud)
SELECT id_GroupFrm, nameStud
FROM tbl_02_Students AS s
WHERE NOT EXISTS (
  SELECT NULL
  FROM tbl_03_GruopsStudents AS g
  WHERE s.nameStud = g.nameStud
    AND g.idGroup = id_GroupFrm
);

Тогда ваш код станет:

Private Sub btnAddRecord_Click()
  With CurrentDb.QueryDefs("qryAssignStudentsToGroup")
    .Parameters("id_GroupFrm") = Me.id_GroupFrm
    .Execute
  End With
  Me.frm_03_GruopsStudents_tbl.Requery
End Sub

Это дает вам гораздо меньше кода для одной и той же вещи, и вы устраняете сложность обработки ошибок, просто отфильтровывая строки.Что еще более важно, вы выполняете массовое обновление один раз , а не для каждой строки, к которой вы прикасаетесь.Это использует мощь базы данных.С DAO.Recordset удобно делать что-то в цикле, но это построчное программирование.Вы действительно хотите получить представление о программировании на основе множеств.

0 голосов
/ 12 февраля 2019

Вам необходимо распутать пути выполнения;нормальное и ошибочное состояния выполнения взаимосвязаны, поэтому любая ошибка, кроме первой, не может быть обработана.

Private Sub btnAddRecord_Click()
    Dim nameStud As String

    Dim rstStud As DAO.Recordset   '
    Dim rstGroupStud As DAO.Recordset '

    Set rstStud = CurrentDb.OpenRecordset("tbl_02_Students", dbOpenSnapshot)  '
    Set rstGroupStud = CurrentDb.OpenRecordset("tbl_03_GruopsStudents", dbOpenDynaset)  '

    ' *** rstStud
    With rstStud
        Do Until .EOF = True
            On Error GoTo ErrHandler
            nameStud = !nameStud

            ' *** rstGroupStud
            With rstGroupStud
                .AddNew

                !idGroup = Me.id_GroupFrm
                !nameStud = nameStud
                ' nameStud
                .Update
            End With
            rstGroupStud.Close
            Me.frm_03_GruopsStudents_tbl.Requery

            Exit Do
TryNext:
            On Error Resume Next
            .MoveNext
            If Err.Number <> 0 Then Exit Do
            On Error GoTo 0
        Loop
    End With

    On Error Resume Next
    rstStud.Close
    Set rstStud = Nothing
    On Error GoTo 0
    Exit Sub

ErrHandler:
    Resume TryNext
End Sub

Таким образом, ErrHandler всегда работает только в состоянии ошибки;TryNext выполняется по «счастливому пути», а Exit Do выходит из цикла (но не из процедуры), так что код очистки может выполняться независимо от результата.

0 голосов
/ 12 февраля 2019

Вы должны вызвать Err.Clear, чтобы сбросить состояние ошибки

errend:
    Err.Clear
    .MoveNext

Я бы позвонил Me.frm_03_GruopsStudents_tbl.Requery после цикла.Нет необходимости постоянно запрашивать форму.

Но переход к другой обычной части кода вместо обращения к обработчику ошибок не является обычным способом обработки ошибок.Чтобы устранить возможность обработки ошибок на MoveNext, измените код следующим образом:

Private Sub btnAddRecord_Click()
    Dim nameStud As String

    Dim rstStud As DAO.Recordset
    Dim rstGroupStud As DAO.Recordset

    Set rstStud = CurrentDb.OpenRecordset("tbl_02_Students", dbOpenSnapshot)
    Set rstGroupStud = CurrentDb.OpenRecordset("tbl_03_GruopsStudents", dbOpenDynaset)

    ' *** rstStud
    With rstStud
        Do Until .EOF = True
            nameStud = !nameStud

            On Error GoTo UpdateError
            ' *** rstGroupStud
            With rstGroupStud
                .AddNew

                !idGroup = Me.id_GroupFrm
                !nameStud = nameStud
                ' nameStud
                .Update
            End With
            rstGroupStud.Close
            Me.frm_03_GruopsStudents_tbl.Requery

            Exit Sub
continue_loop:
            On Error GoTo MoveNextError
            .MoveNext
        Loop
    End With

CleanUp:
    On Error Resume Next
    rstStud.Close
    Set rstStud = Nothing
    Exit Sub

UpdateError:
    Resume continue_loop

MoveNextError:
    MsgBox Err.Description
    Resume CleanUp
End Sub

Этот шаблон является расширяемым.Вы можете добавить столько обработчиков ошибок, сколько потребуется.

...