【发布时间】：2014-10-06 06:15:03
【问题描述】：
我在获取用于审计跟踪的代码以用于子表单时遇到问题。原始代码来自http://www.fontstuff.com/access/acctut21.htm。我宁愿坚持这个代码也不愿使用 Allen Browne 的代码http://allenbrowne.com/appaudit.html。 Screen.ActiveForm.Controls 似乎有问题。我读过这不适用于子表单。有没有办法可以改变它来审核我数据库中的子表单？
在子表单中记录数据时，出现以下错误：Microsoft 找不到您的表达式中引用的字段“CalSubID”。”
在一个模块中我有这段代码（这只是我认为有问题的一部分）：
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
然后在我拥有的子表单的“更新前”和“AfterDelConfirm”事件中（其中“CalSubID”是子表单的 PK，这是主模块代码用来跟踪更改的内容）：
-----------------------------------------------------------------------
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
-----------------------------------------------------------------------
修改代码：
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
【问题讨论】：
-
“CalSubID”是什么/在哪里？哪一行代码产生了错误？
-
需要更完整的代码。例如，您的 AuditChanges 函数在哪里。我在链接中看到了该功能，但您的功能是查看结果集所必需的。
-
CalSubID 是子表单连接到的表的 PK。审计代码从记录的 PK 中运行。其他论坛也有同样问题的帖子，大家都说 Screen.ActiveForm 不适用于子表单。但是除了使用其他形式的审计之外，没有人发布过修复。当之前更新
If Then语句运行时，由于焦点未设置到子表单而出错，因此它告诉我没有名为 CalSubID 的PK，因为由于@987654328，焦点仍设置为主表单@. -
运气好了吗？如果您在使用下面的代码时遇到问题，请随时寻求帮助。
-
在添加下面的代码之前，我想澄清一下，此代码将与现有代码一起工作，这些代码适用于主要表单。从某种意义上说，我想让它检查表单是否是子表单，如果是，运行下面的代码，如果不是，继续使用标准现有代码。
标签： ms-access vba audit-trail subforms