Зарезервированная ошибка при захвате изменений в форме Access 2013 - PullRequest
0 голосов
/ 27 декабря 2018

Я использую код по следующей ссылке в форме Access 2013 для регистрации изменений, внесенных в записи: https://www.techrepublic.com/article/a-simple-solution-for-tracking-changes-to-access-data/

Я закомментировал ErrorHandler и получаю "<Reserved Error>" в течениестрока: If (.Value <> .OldValue or ((Not IsNull ....Это заставляет оператор не читать True и пропускается.

Я звоню по этому Sub в триггере BeforeUpdate в Форме обзора :

Sub ReviewFormAuditTrail(frm As Form, recordid As Control)
    'Track changes to data.
    'recordid identifies the pk field's corresponding
    'control in frm, in order to id record.
    Dim ctl As Control
    Dim varBefore As Variant
    Dim varAfter As Variant
    Dim strControlName As String
    Dim strSQL As String
    Dim ChangeReason As Variant
    'On Error GoTo ErrHandler
    'Get changed values.
      For Each ctl In frm.Controls
      With ctl
    'Avoid labels and other controls with Value property.
    If .ControlType = acComboBox Then
      'Changed this is allow for both null to value and value to null
       If (.Value <> .OldValue) Or ((Not IsNull(.OldValue) And IsNull(.Value))) Or ((IsNull(.OldValue) And Not IsNull(.Value))) Then
        varBefore = .OldValue
        varAfter = .Value
        strControlName = .Name
        ChangeReason = Forms![Review Form]!ChangeReason
        'Build INSERT INTO statement.
        strSQL = "INSERT INTO " _
           & "xAudit (EditDate, User, RecordID, SourceTable, " _
           & " SourceField, BeforeValue, AfterValue, ChangeReason) " _
           & "VALUES (Now()," _
           & cDQ & Environ("username") & cDQ & ", " _
           & cDQ & recordid.Value & cDQ & ", " _
           & cDQ & frm.RecordSource & cDQ & ", " _
           & cDQ & .Name & cDQ & ", " _
           & cDQ & varBefore & cDQ & ", " _
           & cDQ & varAfter & cDQ & "," _
           & cDQ & ChangeReason & cDQ & ")"
        'View evaluated statement in Immediate window.
        Debug.Print strSQL
        DoCmd.SetWarnings False
        DoCmd.RunSQL strSQL
        DoCmd.SetWarnings True
      End If

    ElseIf .ControlType = acTextBox Then
      'Changed this is allow for both null to value and value to null
      If (.Value <> .OldValue) Or ((Not IsNull(.OldValue) And IsNull(.Value))) Or ((IsNull(.OldValue) And Not IsNull(.Value))) Then
        varBefore = .OldValue
        varAfter = .Value
        strControlName = .Name
        ChangeReason = Forms![Review Form]!ChangeReason
        'Build INSERT INTO statement.
        strSQL = "INSERT INTO " _
           & "xAudit (EditDate, User, RecordID, SourceTable, " _
           & " SourceField, BeforeValue, AfterValue, ChangeReason) " _
           & "VALUES (Now()," _
           & cDQ & Environ("username") & cDQ & ", " _
           & cDQ & recordid.Value & cDQ & ", " _
           & cDQ & frm.RecordSource & cDQ & ", " _
           & cDQ & .Name & cDQ & ", " _
           & cDQ & varBefore & cDQ & ", " _
           & cDQ & varAfter & cDQ & "," _
           & cDQ & ChangeReason & cDQ & ")"
        'View evaluated statement in Immediate window.
        Debug.Print strSQL
        DoCmd.SetWarnings False
        DoCmd.RunSQL strSQL
        DoCmd.SetWarnings True
      End If
    End If
    End With
  Next
  Set ctl = Nothing
  Exit Sub

'Added to ignore the error produced from processing in joined tables
ErrHandler:
'If Err.Number = 3251 Then
'    Response = acDataErrContinue
'Else
'    MsgBox Err.Description & vbNewLine _
'    & Err.Number, vbOKOnly, "Error"
'End If
End Sub

1 Ответ

0 голосов
/ 27 декабря 2018

Учитывайте отраслевой стандарт при использовании SQL на прикладном уровне (т. Е. VBA), используя параметризованный запрос с MS Access ' QueryDef.Parameters , который, как я полагаю, является сутью вашей проблемы.

При таком подходе вы отделяете SQL от VBA для лучшей читаемости и удобства обслуживания без необходимости объединять или заключать в кавычки.Приведенная выше ссылка запускает объединенную строку SQL VBA и, как ни странно, не объединяет два повторяющихся блока If:

SQL (сохраняйте, как при любом запросе MS Access)

PARAMETERS paramEditDate Date, paramUser Text(255), paramRecordID Long, 
           paramSourceTable Text(255), paramSourceField Text(255), 
           paramBeforeValue Text(255), paramAfterValue Text(255), paramChangeReason Text(255);
INSERT INTO xAudit (EditDate, [User], RecordID, SourceTable
                    SourceField, BeforeValue, AfterValue, ChangeReason)
VALUES (paramEditDate, paramUser, paramRecordID, paramSourceTable,
        paramSourceField, paramBeforeValue, paramAfterValue, paramChangeReason);

VBA (передать имя формы в качестве аргумента и использовать Forms() collection)

Sub ReviewFormAuditTrail(frm_name As String, recordid As Control)
On Error GoTo ErrHandler    
    'Track changes to data.
    'recordid identifies the pk field's corresponding
    'control in frm, in order to id record.

    Dim ctl As Control
    Dim varBefore As Variant, varAfter As Variant, ChangeReason As Variant
    Dim strControlName As String, strSQL As String
    Dim qdef As QueryDef

    'Get changed values.
    For Each ctl In Forms(frm_name).Controls
       With ctl
          'Avoid labels and other controls with Value property.
          If .ControlType = acComboBox Or .ControlType = acTextBox Then
             'Changed this is allow for both null to value and value to null
              If (.Value <> .OldValue) Or ((Not IsNull(.OldValue) And IsNull(.Value))) _
                Or ((IsNull(.OldValue) And Not IsNull(.Value))) Then

                   varBefore = .OldValue
                   varAfter = .Value
                   strControlName = .Name
                   ChangeReason = Forms![Review Form]!ChangeReason

                   ' RETRIEVE SAVED QUERY
                   Set qdef = CurrentDb.QueryDefs("mySavedQuery")

                   ' BIND PARAMS
                   qdef!paramEditDate = Now()
                   qdef!paramUser = Environ("username")
                   qdef!paramRecordID = recordid.Value
                   qdef!paramSourceTable = Forms(frm_name).RecordSource
                   qdef!paramSourceField = strControlName
                   qdef!paramBeforeValue = varBefore
                   qdef!paramAfterValue = varAfter
                   qdef!paramChangeReason = ChangeReason

                   ' EXECUTE QUERY
                   qdef.Execute dbFailOnError

              End If
          End if
       End With
    Next ctl

ExitHandler:
   Set ctl = Nothing: Set qdef = Nothing
   Exit Sub 

ErrHandler:
  MsgBox Err.Description & vbNewLine & Err.Number, vbOKOnly, "Runtime Error"
  Resume ExitHandler
End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...