Access 2010 数据库中的审计跟踪

Question

我正在尝试在 Access 2010 数据库中创建审计跟踪。我在 www.wvmitchell.com 上找到了一些代码，除了一个问题外，它运行良好。它记录更新的记录，但不记录新记录或删除的记录。记录这些非常重要。以下是我使用的资料和代码：

Option Compare Database
Option Explicit

Sub TrackChanges(F As Form)
Dim ctl As Control, frm As Form
Dim MyField As String, MyKey As Long, MyTable As String
Dim db As DAO.Database, rs As DAO.Recordset
On Error Resume Next
Set frm = F
Set db = CurrentDb
Set rs = db.OpenRecordset("tbl__ChangeTracker")
With frm
    MyTable = .Tag
    ' find the primary key & its value, based on the Tag
    For Each ctl In .Controls
        If ctl.Tag = "PK" Then
            MyField = ctl.Name
            MyKey = ctl
            Exit For
        End If
    Next ctl
    For Each ctl In .Controls
        ' inspect only data-bound controls
        Select Case ctl.ControlType
            Case acTextBox, acComboBox, acCheckBox
                If Nz(ctl.ControlSource, "") > "" Then
                    ' if changed, record both old & new values
                    If Nz(ctl.OldValue, "")<> Nz(ctl, "") Then
                        rs.AddNew
                        rs!FormName = .Name
                        rs!MyTable = MyTable
                        rs!MyField = MyField
                        rs!MyKey = MyKey
                        rs!ChangedOn = Now()
                        rs!FieldName = ctl.Name
                        If ctl.ControlType = acCheckBox Then
                            rs!Field_OldValue = YesOrNo(ctl.OldValue)
                            rs!Field_NewValue = YesOrNo(ctl)
                        Else
                            rs!Field_OldValue = Left(Nz(ctl.OldValue, ""), 255)
                            rs!Field_NewValue = Left(Nz(ctl, ""), 255)
                        End If
                        rs!UserChanged = UserName()
                        rs!CompChanged = CompName()
                        rs.Update
                    End If
                End If
        End Select
    Next ctl
End With
rs.Close
Set rs = Nothing
Set db = Nothing
End Sub

Private Function YesOrNo(v) As String
    Select Case v
        Case -1
            YesOrNo = "Yes"
        Case 0
            YesOrNo = "No"
    End Select
End Function

一个table来存储结果。对于文本字段，我在说明中指出了长度：

这是一个 VBA 模块，它将为您创建 table。

Option Compare Database
Option Explicit

Sub Create_tbl__ChangeTracker()
    Dim db As DAO.Database
    Dim fld As DAO.Field
    Dim idx As DAO.Index
    Dim tdf As DAO.TableDef
    '
    Set db = CurrentDb
    Set tdf = db.CreateTableDef("tbl__ChangeTracker")
With tdf
    ' ID is AutoNumber and Primary Key
    Set fld = .CreateField("ID", dbLong)
    fld.Attributes = dbAutoIncrField
    .Fields.Append fld
    Set idx = .CreateIndex("ID")
    idx.Fields = "ID"
    idx.Primary = True
    .Indexes.Append idx
    '
    ' add remaining fields
    Set fld = .CreateField("FormName", dbText, 64)
    .Fields.Append fld
    Set fld = .CreateField("MyTable", dbText, 64)
    .Fields.Append fld
    Set fld = .CreateField("MyField", dbText, 64)
    .Fields.Append fld
    Set fld = .CreateField("MyKey", dbText, 64)
    .Fields.Append fld
    Set fld = .CreateField("ChangedOn", dbDate)
    .Fields.Append fld
    Set fld = .CreateField("FieldName", dbText, 64)
    .Fields.Append fld
    Set fld = .CreateField("Field_OldValue", dbText, 255)
    .Fields.Append fld
    Set fld = .CreateField("Field_NewValue", dbText, 255)
    .Fields.Append fld
    Set fld = .CreateField("UserChanged", dbText, 128)
    .Fields.Append fld
    Set fld = .CreateField("CompChanged", dbText, 128)
    .Fields.Append fld
    Set fld = .CreateField("Action", dbtext, 64
    .Fields.Append fld
End With
db.TableDefs.Append tdf
Set idx = Nothing
Set fld = Nothing
Set tdf = Nothing
Set db = Nothing
End Sub

添加完这些对象后，修改每个表单如下： 1. 为表格设置 Tag 属性 = 标的名称 table。 2. 确定表单后面数据的主键，并设置Tag 属性 = "PK"（不带引号）。该字段不必在表单上可见，它只需要在某处即可。 3. 添加

Form_BeforeUpdate event and invoke the tracking code using:
   TrackChanges Me

4。如果您使用子表单，您还需要为每个子表单执行这三个步骤。

在我的数据库中，我向 tbl_ChangeTracker 添加了一个名为 Action 的文本字段。我需要知道如何编写代码来填充它。提前感谢我得到的任何帮助。

Answer 1

你的代码已经写好了；

                If Nz(ctl.ControlSource, "") > "" Then
                ' if changed, record both old & new values
                If Nz(ctl.OldValue, "")<> Nz(ctl, "") Then

它指定是否更改记录旧值和新值。您没有任何内容可以指定添加新值时要执行的操作。

在表单的更新前程序中放置以下内容；

   If Me.NewRecord Then
        Call TrackChanges(me, "NEW")
    Else
        Call TrackChanges(me ,"EDIT")
    End If

然后使用您的审计程序将其更改为接受另一个 String 类型的参数，例如；

Sub TrackChanges(F As Form, action As String)

然后在你的代码中你想要;

Select Case action
Case is = "New"
 ' code here for adding new record, as an example
Case is = "Edit"
'your code as you have it above here for edits

如果你想跟踪删除，在删除前事件中做同样的事情；

Call TrackChanges(Me,"DELETE")

然后在您的 TrackChanges 程序中有另一个 Case = "Delete" 然后是处理删除的代码。

这应该会让您走上正确的道路，然后您可以在操作字段中执行 !action = action 以便您知道它是编辑添加还是删除等。

HTH 马克

在您的评论后编辑 1，这样您就可以看到布局； Select 案例代码将在您的 TrackChanges 函数中。在 'with Frm' 之前放置 select 案例。那么你要设置如下;

Select Case action
 Case is = "Edit"
       With frm 'etc all your code here for if you edit record
Case is = "new"
       With frm 'etc all your code here for if adding new record
End select

让我知道这是否有意义，如果没有，请给我发私信，如果您需要，我可以更深入地与您讨论 :)

Access 2010 数据库中的审计跟踪

Audit trail in Access 2010 database

audit

logging

vba

ms-access-2010