在子表单Access 2010的审计跟踪 [英] Access 2010 Audit Trail on SubForms

查看：279
本文介绍了在子表单Access 2010的审计跟踪的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！

问题描述

我有麻烦了code我发现审计线索和子表单的工作。该origninal code是 http://www.fontstuff.com/access/acctut21.htm 。我宁愿坚持使用这样的code比使用艾伦·布朗的code http://allenbrowne.com/appaudit html的。这似乎是与 Screen.ActiveFor​​m.Controls 的一个问题。我已阅读，这并不与子窗体。有没有一种方法，我可以改变这个在我的数据库审计子表单？

当我在子窗体记录的数据，我得到以下错误：微软无法找到域CalSubID指的是在你的前pression

在一个模块我有这个code（这只是它的一部分，我认为是有问题的）：

 子AuditChanges（IDField作为字符串，UserAction作为字符串）
对错误转到AuditChanges_Err
昏暗CNN作为ADODB.Connection
昏暗首先作为ADODB.Recordset
昏暗的CTL作为控制
昏暗datTimeCheck随着日期
昏暗strUserID作为字符串
设置CNN = CurrentProject.Connection
首先设置=新ADODB.Recordset
rst.OpenSELECT * FROM tblAuditTrail，CNN，adOpenDynamic，ADLOCKOPTIMISTIC
datTimeCheck = NOW（）
strUserID =窗体！登录！cboUser.Column（1）
选择案例UserAction
    案编辑
        对于每个CTL在Screen.ActiveFor​​m.Controls
            如果ctl.Tag =审计然后
                如果NZ（ctl.Value）＆LT;＆GT;新西兰（ctl.OldValue）然后
                    随着RST
                        。添新
                        ！[日期时间] = datTimeCheck
                        ！[用户名] = strUserID
                        ！[窗体名称] = Screen.ActiveFor​​m.Name
                        ！[动作] = UserAction
                        ！[的recordId] = Screen.ActiveFor​​m.Controls（IDField）.value的
                        ！[字段名] = ctl.ControlSource
                        ！[的OldValue] = ctl.OldValue
                        ！[的NewValue] = ctl.Value
                        .Update
                    结束与
                结束如果
            结束如果
        接下来CTL
    案例否则
        随着RST
            。添新
            ！[日期时间] = datTimeCheck
            ！[用户名] = strUserID
            ！[窗体名称] = Screen.ActiveFor​​m.Name
            ！[动作] = UserAction
            ！[的recordId] = Screen.ActiveFor​​m.Controls（IDField）.value的
            .Update
        结束与
最终选择
AuditChanges_Exit：
在错误恢复下一页
rst.Close
cnn.Close
第一个设置=什么
设置CNN =没有
退出小组
AuditChanges_Err：
MSGBOX Err.Description它将，vbCritical，错误！
简历AuditChanges_Exit
结束小组

然后在我的更新前和AfterDelConfirm事件子窗体我有（其中CalSubID是PK的子窗体，这是主要的模块code用来跟踪更改）：

  -------------------------------------- ---------------------------------
私人小组Form_BeforeUpdate（取消作为整数）
如果Me.NewRecord然后
    呼叫AuditChanges（CalSubID，新）
其他
    呼叫AuditChanges（CalSubID，编辑）
结束如果
结束小组
-------------------------------------------------- ---------------------
私人小组Form_AfterDelConfirm（状态为整数）
如果状态= acDeleteOK然后调用AuditChanges（CalSubID，删除）
结束小组
-------------------------------------------------- ---------------------

修改code：

 子AuditChanges（IDField作为字符串，UserAction作为字符串）
对错误转到AuditChanges_Err
昏暗CNN作为ADODB.Connection
昏暗首先作为ADODB.Recordset
昏暗的CTL作为控制
昏暗datTimeCheck随着日期
昏暗strUserID作为字符串

加code
昏暗SubFormName作为字符串

设置CNN = CurrentProject.Connection
首先设置=新ADODB.Recordset
rst.OpenSELECT * FROM tblAuditTrail，CNN，adOpenDynamic，ADLOCKOPTIMISTIC
datTimeCheck = NOW（）
strUserID =窗体！登录！cboUser.Column（1）

MSGBOX显示名称（只是现在测试code）
MSGBOX（与＆amp; Screen.ActiveFor​​m.Name和放大器;）

IF THEN语句，如果用户使用的是形式与子窗体检查
如果Screen.ActiveFor​​m.Name =校准表，然后
SubFormName =校准表子

    选择案例UserAction
    案编辑
        对于每个CTL在Screen.ActiveFor​​m
            如果ctl.ControlType = acSubform然后
            SubFormName = ctl.Name
            如果ctl.Tag =审计然后
                如果NZ（ctl.Value）＆LT;＆GT;新西兰（ctl.OldValue）然后
                    随着RST
                        。添新
                        ！[日期时间] = datTimeCheck
                        ！[用户名] = strUserID
                        ！[窗体名称] = SubFormName
                        ！[动作] = UserAction
                        ！[的recordId] =窗体！[Screen.ActiveFor​​m.Name]！[SubFormName] .FORM！[IDField] .value的
                        ！[字段名] = ctl.ControlSource
                        ！[的OldValue] = ctl.OldValue
                        ！[的NewValue] = ctl.Value
                        .Update
                    结束与
                结束如果
            结束如果
获取错误信息下面的---接着ctl--线，明年没有了的消息....
        接下来CTL
    案例否则
        随着RST
            。添新
            ！[日期时间] = datTimeCheck
            ！[用户名] = strUserID
            ！[窗体名称] = SubFormName
            ！[动作] = UserAction
            ！[的recordId] =窗体！[Screen.ActiveFor​​m.Name]！[SubFormName] .FORM！[IDField] .value的
            .Update
        结束与
        设置CTL =什么
最终选择

其他

选择案例UserAction
    案编辑
        对于每个CTL在Screen.ActiveFor​​m.Controls
            如果ctl.Tag =审计然后
                如果NZ（ctl.Value）＆LT;＆GT;新西兰（ctl.OldValue）然后
                    随着RST
                        。添新
                        ！[日期时间] = datTimeCheck
                        ！[用户名] = strUserID
                        ！[窗体名称] = Screen.ActiveFor​​m.Name
                        ！[动作] = UserAction
                        ！[的recordId] = Screen.ActiveFor​​m.Controls（IDField）.value的
                        ！[字段名] = ctl.ControlSource
                        ！[的OldValue] = ctl.OldValue
                        ！[的NewValue] = ctl.Value
                        .Update
                    结束与
                结束如果
            结束如果
        接下来CTL
    案例否则
        随着RST
            。添新
            ！[日期时间] = datTimeCheck
            ！[用户名] = strUserID
            ！[窗体名称] = Screen.ActiveFor​​m.Name
            ！[动作] = UserAction
            ！[的recordId] = Screen.ActiveFor​​m.Controls（IDField）.value的
            .Update
        结束与
最终选择


AuditChanges_Exit：
在错误恢复下一页
rst.Close
cnn.Close
第一个设置=什么
设置CNN =没有
退出小组
AuditChanges_Err：
MSGBOX Err.Description它将，vbCritical，错误！
简历AuditChanges_Exit
结束小组

解决方案

我是presuming你的错误是用线（这将有助于如果您将验证）：

 ！[的recordId] = Screen.ActiveFor​​m.Controls（IDField）.value的

正如您所指出的问题是，你不能访问子窗体控件这种方式，但必须以这种方式引用：

 ！[的recordId] =窗体！[主表单名称]！[子控件名称] .FORM！[控件名称] .value的

在你的情况，你需要先找到子控件名称（presuming你只有1子窗体）

 访问每个控件的形式
昏暗的CTL作为控制
昏暗的SubFormName作为字符串
SubFormName =
对于每个CTL在Screen.ActiveFor​​m
    如果ctl.ControlType = acSubform然后
        SubFormName = ctl.Name
        退出的
    结束如果
接下来CTL
设置CTL =什么

现在设置的recordId时，在code，你可以做到这一点是这样的：

 '你应该检查SubFormName不是这个下一行之前的空...
！[的recordId] =窗体！[Screen.ActiveFor​​m.Name]！[SubformName] .FORM！[IDField] .value的

我没有测试过这一点，我有点生锈的访问，所以采取的概念和固定的语法。

**更新** - 这里是code我会尝试与你所提供的新信息。我是presuming的控件（例如一个与ctl.Tag =审计）都在子窗体

 子AuditChanges（IDField作为字符串，UserAction作为字符串）
对错误转到AuditChanges_Err
昏暗CNN作为ADODB.Connection
昏暗首先作为ADODB.Recordset
昏暗的CTL作为控制
昏暗datTimeCheck随着日期
昏暗strUserID作为字符串

加code
昏暗SubFormName作为字符串

设置CNN = CurrentProject.Connection
首先设置=新ADODB.Recordset
rst.OpenSELECT * FROM tblAuditTrail，CNN，adOpenDynamic，ADLOCKOPTIMISTIC
datTimeCheck = NOW（）
strUserID =窗体！登录！cboUser.Column（1）

MSGBOX显示名称（只是现在测试code）
MSGBOX（与＆amp; Screen.ActiveFor​​m.Name和放大器;）

IF THEN语句，如果用户使用的是形式与子窗体检查
如果Screen.ActiveFor​​m.Name =校准表，然后
  SubFormName =校准表子

    选择案例UserAction
    案编辑
        对于每个CTL在窗体！[校准表]！[卡尔形式分] .FORM
            如果ctl.Tag =审计然后
                如果NZ（ctl.Value）＆LT;＆GT;新西兰（ctl.OldValue）然后
                    随着RST
                        。添新
                        ！[日期时间] = datTimeCheck
                        ！[用户名] = strUserID
                        ！[窗体名称] = SubFormName
                        ！[动作] = UserAction
                        ！[的recordId] =窗体！[校准表]！[卡尔形式分] .FORM！[IDField] .value的
                        ！[字段名] = ctl.ControlSource
                        ！[的OldValue] = ctl.OldValue
                        ！[的NewValue] = ctl.Value
                        .Update
                    结束与
                结束如果
            结束如果
        接下来CTL
    案例否则
        随着RST
            。添新
            ！[日期时间] = datTimeCheck
            ！[用户名] = strUserID
            ！[窗体名称] = SubFormName
            ！[动作] = UserAction
            ！[的recordId] =窗体！[校准表]！[卡尔形式分] .FORM！[IDField] .value的
            .Update
        结束与
        设置CTL =什么
    最终选择

其他

  选择案例UserAction
      案编辑
          对于每个CTL在Screen.ActiveFor​​m.Controls
              如果ctl.Tag =审计然后
                  如果NZ（ctl.Value）＆LT;＆GT;新西兰（ctl.OldValue）然后
                      随着RST
                          。添新
                          ！[日期时间] = datTimeCheck
                          ！[用户名] = strUserID
                          ！[窗体名称] = Screen.ActiveFor​​m.Name
                          ！[动作] = UserAction
                          ！[的recordId] = Screen.ActiveFor​​m.Controls（IDField）.value的
                          ！[字段名] = ctl.ControlSource
                          ！[的OldValue] = ctl.OldValue
                          ！[的NewValue] = ctl.Value
                          .Update
                      结束与
                  结束如果
              结束如果
          接下来CTL
      案例否则
          随着RST
              。添新
              ！[日期时间] = datTimeCheck
              ！[用户名] = strUserID
              ！[窗体名称] = Screen.ActiveFor​​m.Name
              ！[动作] = UserAction
              ！[的recordId] = Screen.ActiveFor​​m.Controls（IDField）.value的
              .Update
          结束与
  最终选择
结束如果

AuditChanges_Exit：
    在错误恢复下一页
    rst.Close
    cnn.Close
    第一个设置=什么
    设置CNN =没有
    退出小组
AuditChanges_Err：
    MSGBOX Err.Description它将，vbCritical，错误！
    简历AuditChanges_Exit
    结束小组

I am having trouble getting the code I found for an audit trail to work with sub forms. The origninal code is from http://www.fontstuff.com/access/acctut21.htm. I would rather stick to this code than using Allen Browne's code http://allenbrowne.com/appaudit.html. It seems to be a problem with Screen.ActiveForm.Controls. I have read that this does not work with sub forms. Is there a way I can alter this to audit a sub form in my database?

When I record the data in the sub form, I get the following error: Microsoft can't find the field "CalSubID" referred to in your expression."

In a module I have this code (this is just part of it that I think is having issues):

Sub AuditChanges(IDField As String, UserAction 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 = Forms!Login!cboUser.Column(1)
Select Case UserAction
    Case "EDIT"
        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
                        ![Action] = UserAction
                        ![RecordID] = Screen.ActiveForm.Controls(IDField).Value
                        ![FieldName] = ctl.ControlSource
                        ![OldValue] = ctl.OldValue
                        ![NewValue] = ctl.Value
                        .Update
                    End With
                End If
            End If
        Next ctl
    Case Else
        With rst
            .AddNew
            ![DateTime] = datTimeCheck
            ![UserName] = strUserID
            ![FormName] = Screen.ActiveForm.Name
            ![Action] = UserAction
            ![RecordID] = Screen.ActiveForm.Controls(IDField).Value
            .Update
        End With
End Select
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

Then in my "before update" and "AfterDelConfirm" events for the subform I have (where "CalSubID" is the PK for the subform and this is what the main module code uses to track the changes):

-----------------------------------------------------------------------
Private Sub Form_BeforeUpdate(Cancel As Integer)
If Me.NewRecord Then
    Call AuditChanges("CalSubID", "NEW")
Else
    Call AuditChanges("CalSubID", "EDIT")
End If
End Sub
-----------------------------------------------------------------------
Private Sub Form_AfterDelConfirm(Status As Integer)
If Status = acDeleteOK Then Call AuditChanges("CalSubID", "DELETE")
End Sub
-----------------------------------------------------------------------

Modified Code:

Sub AuditChanges(IDField As String, UserAction 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

'added code
Dim SubFormName As String

Set cnn = CurrentProject.Connection
Set rst = New ADODB.Recordset
rst.Open "SELECT * FROM tblAuditTrail", cnn, adOpenDynamic, adLockOptimistic
datTimeCheck = Now()
strUserID = Forms!Login!cboUser.Column(1)

'msgbox to display name (just for now to test code)
MsgBox (" " & Screen.ActiveForm.Name & " ")

'IF THEN statement to check if user is using form with subform
If Screen.ActiveForm.Name = "Cal Form" Then
SubFormName = "Cal Form Sub"

    Select Case UserAction
    Case "EDIT"
        For Each ctl In Screen.ActiveForm
            If ctl.ControlType = acSubform Then
            SubFormName = ctl.Name
            If ctl.Tag = "Audit" Then
                If Nz(ctl.Value) <> Nz(ctl.OldValue) Then
                    With rst
                        .AddNew
                        ![DateTime] = datTimeCheck
                        ![UserName] = strUserID
                        ![FormName] = SubFormName
                        ![Action] = UserAction
                        ![RecordID] = Forms![Screen.ActiveForm.Name]![SubFormName].Form![IDField].Value
                        ![FieldName] = ctl.ControlSource
                        ![OldValue] = ctl.OldValue
                        ![NewValue] = ctl.Value
                        .Update
                    End With
                End If
            End If
'Getting error message at the --Next ctl-- line below, "next without for" message....
        Next ctl
    Case Else
        With rst
            .AddNew
            ![DateTime] = datTimeCheck
            ![UserName] = strUserID
            ![FormName] = SubFormName
            ![Action] = UserAction
            ![RecordID] = Forms![Screen.ActiveForm.Name]![SubFormName].Form![IDField].Value
            .Update
        End With
        Set ctl = Nothing
End Select

Else

Select Case UserAction
    Case "EDIT"
        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
                        ![Action] = UserAction
                        ![RecordID] = Screen.ActiveForm.Controls(IDField).Value
                        ![FieldName] = ctl.ControlSource
                        ![OldValue] = ctl.OldValue
                        ![NewValue] = ctl.Value
                        .Update
                    End With
                End If
            End If
        Next ctl
    Case Else
        With rst
            .AddNew
            ![DateTime] = datTimeCheck
            ![UserName] = strUserID
            ![FormName] = Screen.ActiveForm.Name
            ![Action] = UserAction
            ![RecordID] = Screen.ActiveForm.Controls(IDField).Value
            .Update
        End With
End Select


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

解决方案

I'm presuming your error is with the line (it would help if you would verify):

![RecordID] = Screen.ActiveForm.Controls(IDField).Value

The issue as you've stated is that you can't access subform controls this way but must reference in this manner:

![RecordID] = Forms![main form name]![subform control name].Form![control name].Value

In your case, you need to first find the subform control name (presuming you only have 1 subform)

' Visit each control on the form
Dim ctl As Control
Dim SubFormName as string
SubFormName = ""
For Each ctl In Screen.ActiveForm
    If ctl.ControlType = acSubform Then
        SubFormName = ctl.Name
        exit for
    End If
Next ctl
Set ctl = Nothing

Now in your code when setting RecordID, you can do it like this:

' you should check that SubFormName is not empty before this next line...
![RecordID] = Forms![Screen.ActiveForm.Name]![SubformName].Form![IDField].Value

I have not tested this and I'm a bit rusty on Access, so take the concept and fix the syntax.

** UPDATE** - Here is the code I would try with the new information you have provided. I am presuming that the controls (e.g. the one with ctl.Tag = "Audit") are all on the subform

Sub AuditChanges(IDField As String, UserAction 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

'added code
Dim SubFormName As String

Set cnn = CurrentProject.Connection
Set rst = New ADODB.Recordset
rst.Open "SELECT * FROM tblAuditTrail", cnn, adOpenDynamic, adLockOptimistic
datTimeCheck = Now()
strUserID = Forms!Login!cboUser.Column(1)

'msgbox to display name (just for now to test code)
MsgBox (" " & Screen.ActiveForm.Name & " ")

'IF THEN statement to check if user is using form with subform
If Screen.ActiveForm.Name = "Cal Form" Then
  SubFormName = "Cal Form Sub"

    Select Case UserAction
    Case "EDIT"
        For Each ctl In Forms![Cal Form]![Cal Form Sub].Form
            If ctl.Tag = "Audit" Then
                If Nz(ctl.Value) <> Nz(ctl.OldValue) Then
                    With rst
                        .AddNew
                        ![DateTime] = datTimeCheck
                        ![UserName] = strUserID
                        ![FormName] = SubFormName
                        ![Action] = UserAction
                        ![RecordID] = Forms![Cal Form]![Cal Form Sub].Form![IDField].Value
                        ![FieldName] = ctl.ControlSource
                        ![OldValue] = ctl.OldValue
                        ![NewValue] = ctl.Value
                        .Update
                    End With
                End If
            End If
        Next ctl
    Case Else
        With rst
            .AddNew
            ![DateTime] = datTimeCheck
            ![UserName] = strUserID
            ![FormName] = SubFormName
            ![Action] = UserAction
            ![RecordID] = Forms![Cal Form]![Cal Form Sub].Form![IDField].Value
            .Update
        End With
        Set ctl = Nothing
    End Select

Else

  Select Case UserAction
      Case "EDIT"
          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
                          ![Action] = UserAction
                          ![RecordID] = Screen.ActiveForm.Controls(IDField).Value
                          ![FieldName] = ctl.ControlSource
                          ![OldValue] = ctl.OldValue
                          ![NewValue] = ctl.Value
                          .Update
                      End With
                  End If
              End If
          Next ctl
      Case Else
          With rst
              .AddNew
              ![DateTime] = datTimeCheck
              ![UserName] = strUserID
              ![FormName] = Screen.ActiveForm.Name
              ![Action] = UserAction
              ![RecordID] = Screen.ActiveForm.Controls(IDField).Value
              .Update
          End With
  End Select
End If

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

这篇关于在子表单Access 2010的审计跟踪的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！

查看全文
相关文章
Access最新文章
热门教程
热门工具
登录 关闭
扫码关注1秒登录
发送“验证码”获取 | 15天全站免登陆