Ändern von Access VBA zum Erfassen von Änderungen in Formularen

Question

Ich habe diesen Code online (http://www.fontstuff.com/access/acctut21.htm) gefunden, um Änderungen an Tabellen zu erfassen. Der Code funktioniert in der Beispieldatenbank, die bereitgestellt wurde, funktioniert aber nicht in meiner Datenbank. Sowohl für das Beispiel als auch für meine Datenbank werden Änderungen über Formulare vorgenommen und durch eine Ereignisprozedur in den Formulareigenschaften unter "Vor dem Update" ausgelöst. Ich bekomme keine Fehler, aber nichts wird in die Audit-Tabelle geschrieben. Ein Unterschied zwischen meinem Formular und dem Beispiel besteht darin, dass mein Formular Daten aus mehreren Tabellen durch eine Abfrage zieht und Aktualisierungen an mehreren Tabellen vorgenommen werden. Das Beispielformular zeigt nur Felder aus einer Tabelle und Aktualisierungen werden nur für eine Tabelle vorgenommen.

Wie kann ich diesen Code erhalten, um meine Änderungen aufzuzeichnen?

Option Compare Database 
Option Explicit 
Sub AuditChanges(IDField As String) 
    On Error GoTo AuditChanges_Err 
    Dim cnn As ADODB.Connection 
    Dim rst As ADODB.Recordset 
    Dim ctl As Control 
    Dim datTimeCheck As Date 
    Dim strUserID As String 
    Set cnn = CurrentProject.Connection 
    Set rst = New ADODB.Recordset 
    rst.Open "SELECT * FROM tblAuditTrail", cnn, adOpenDynamic, adLockOptimistic 
    datTimeCheck = Now() 
    strUserID = Environ("USERNAME") 
    For Each ctl In Screen.ActiveForm.Controls 
     If ctl.Tag = "Audit" Then 
      If Nz(ctl.Value) <> Nz(ctl.OldValue) Then 
       With rst 
        .AddNew 
        ![DateTime] = datTimeCheck 
        ![UserName] = strUserID 
        ![FormName] = Screen.ActiveForm.NAME 
        ![RecordID] = Screen.ActiveForm.Controls(IDField).Value 
        ![FieldName] = ctl.ControlSource 
        ![OldValue] = ctl.OldValue 
        ![NewValue] = ctl.Value 
        .Update 
       End With 
      End If 
     End If 
    Next ctl 
AuditChanges_Exit: 
    On Error Resume Next 
    rst.Close 
    cnn.Close 
    Set rst = Nothing 
    Set cnn = Nothing 
    Exit Sub 
AuditChanges_Err: 
    MsgBox Err.Description, vbCritical, "ERROR!" 
    Resume AuditChanges_Exit 
End Sub 

Answer 1

Dies ist der Code, den ich zum Erstellen eines Überwachungsprotokolls verwende. Es funktioniert gut und kann ItemTypes den Protokolleinträgen zuweisen. Dies ist nützlich, um einzelne Einträge zu einem bestimmten Artikeltyp (wie Bestellung, Kunde, Lagerartikel usw.) anzuzeigen.

wird es durch genannt:

Private Sub Form_BeforeUpdate(Cancel As Integer) 
On Error Resume Next 
AuditLog Me, "Order", Me.ID 
End Sub 

Funktionscode

Public Sub AuditLog(frm As Form, ItemType As String, ItemID As Integer, Optional exControl As Variant) 
Dim ctl As Control 
Dim varBefore As Variant 
Dim varAfter As Variant 
Dim strControlName As String 
Dim strSql As String 
On Error Resume Next 

For Each ctl In frm.Controls 
With ctl 
'Avoid labels and other controls with Value property. 
If .ControlType = acTextBox Or acComboBox Or acCheckBox Then 
If .Tag = 1 Then 

Else 
If IsOldValueAvailable(ctl) = True Then 
    If Nz(.Value, "[Empty]") <> Nz(.OldValue, "[Empty]") Then 
    varBefore = .OldValue 
    varAfter = .Value 
    strControlName = .Name 
    strSql = "INSERT INTO [UserActivities] (UserID,Entry,[Field],OldValue,NewValue,Type,ItemID) " & _ 
    "Values ('" & userid & "','Value Change','" & strControlName & "','" & varBefore & "','" & varAfter & "','" & ItemType & "','" & ItemID & "');" 

    CurrentDb.Execute strSql, dbFailOnError 

End If 
    End If 
    End If 
End If 
End With 
Next 
Set ctl = Nothing 
Exit Sub 

ErrHandler: 
MsgBox err.Description & vbNewLine _ 
& err.Number, vbOKOnly, "Error" 
End Sub