未绑定表单/文本框的审计跟踪
Posted
技术标签:
【中文标题】未绑定表单/文本框的审计跟踪【英文标题】:Audit Trail for unbound forms/textboxes 【发布时间】:2014-08-07 01:22:22 【问题描述】:我一直在寻找有关如何在我的 access 2010 数据库中实施审计跟踪的方法。有很多解决方案在绑定表单时效果很好,但是我有几个未绑定的表单并执行我希望对其进行审计跟踪的某些关键功能(由于必须根据不同的表编辑不同的表,它们是未绑定的用户输入、通过 VB 和 SQL 脚本执行的功能,因此将它们绑定到表将不起作用)。但是,如果不进行数周和数周的自定义编码,对于这种类型的审计似乎没有简单的解决方案。有人对如何做到这一点有任何想法吗?有没有一种无需绑定表单即可审核所有活动的方法?难道我不能只使用代码来监控表格的变化,而不必查看表单背面的代码吗?
【问题讨论】:
视情况而定。数据宏可能对你有用msdn.microsoft.com/en-us/library/office/… 例如***.com/questions/14816865/… 【参考方案1】:我最近做了这个!
每个表单都有将更改写入表的代码。
当您丢失 Screen.ActiveForm.Controls
作为参考时,审核跟踪会变得有些棘手 - 如果您使用导航表单,则会发生这种情况。
它也使用 Sharepoint 列表,所以我发现没有任何已发布的方法可用。
我(经常)使用中间的表单作为显示层,我发现它也必须在下一个表单中触发 Form_Load 代码。 一旦它们打开,它们就需要自我维持。
模块变量;
Dim Deleted() As Variant
Private Sub Form_BeforeUpdate(Cancel As Integer)
'Audit Trail - New Record, Edit Record
Dim rst As Recordset
Dim ctl As Control
Dim strSql As String
Dim strTbl As String
Dim strSub As String
strSub = Me.Caption & " - BeforeUpdate"
If TempVars.Item("AppErrOn") Then
On Error Resume Next 'On Error GoTo Err_Handler
Else
On Error GoTo 0
End If
strTbl = "tbl" & TrimL(Me.Caption, 6)
strSql = "SELECT * FROM tblzzAuditTrail WHERE DateTimeMS = #" & GetTimeUTC & "#;"
Set rst = dbLocal.OpenRecordset(strSql)
For Each ctl In Me.Detail.Controls
If ctl.ControlType = acTextBox Or ctl.ControlType = acComboBox Then
If ctl.Name <> "DateUpdated" Then
If Nz(ctl.Value) <> Nz(ctl.OldValue) Then
If Me.NewRecord Then
With rst
.AddNew
!DateTimeMS = GetTimeUTC()
!UserID = TempVars.Item("CurrentUserID")
!ClientID = TempVars.Item("frmClientOpenID")
!RecordID = Me.Text26
!ActionID = 1
!TableName = strTbl
!FieldName = ctl.ControlSource
!NewValue = ctl.Value
.Update
End With
Else
With rst
.AddNew
!DateTimeMS = GetTimeUTC()
!UserID = TempVars.Item("CurrentUserID")
!ClientID = TempVars.Item("frmClientOpenID")
!RecordID = Me.Text26
!ActionID = 2
!TableName = strTbl
!FieldName = ctl.ControlSource
!NewValue = ctl.Value
!OldValue = ctl.OldValue
.Update
End With
End If
End If
End If
End If
Next ctl
rst.Close
Set rst = Nothing
Exit Sub
Err_Handler:
Select Case Err.Number
Case 3265
Resume Next 'Item not found in recordset
Case Else
'Unexpected Error
MsgBox "The following error has occurred" & vbCrLf & vbCrLf & "Error Number: " & _
Err.Number & vbCrLf & "Error Source: " & strSub & vbCrLf & "Error Description: " & _
Err.Description, vbExclamation, "An Error has Occured!"
End Select
rst.Close
Set rst = Nothing
End Sub
Private Sub Form_Delete(Cancel As Integer)
Dim ctl As Control
Dim i As Integer
Dim strTbl As String
strTbl = "tbl" & TrimL(Me.Caption, 6)
ReDim Deleted(3, 1)
For Each ctl In Me.Detail.Controls
If ctl.ControlType <> acLabel Then
' Debug.Print .Name
If ctl.Name <> "State" And ctl.Name <> "Pcode" Then
If Nz(ctl.Value) <> "" Then
Deleted(0, i) = ctl.ControlSource
Deleted(1, i) = ctl.Value
Deleted(2, i) = Me.Text26
' Debug.Print Deleted(0, i) & ", " & Deleted(1, i)
i = i + 1
ReDim Preserve Deleted(3, i)
End If
End If
End If
Next ctl
End Sub
Private Sub Form_AfterDelConfirm(Status As Integer)
Dim rst As Recordset
Dim ctl As Control
Dim strSql As String
Dim strTbl As String
Dim i As Integer
Dim strSub As String
strSub = Me.Caption & " - AfterDelConfirm"
If TempVars.Item("AppErrOn") Then
On Error Resume Next 'On Error GoTo Err_Handler
Else
On Error GoTo 0
End If
strTbl = "tbl" & TrimL(Me.Caption, 6)
strSql = "SELECT * FROM tblzzAuditTrail WHERE DateTimeMS = #" & GetTimeUTC() & "#;"
Set rst = dbLocal.OpenRecordset(strSql)
'Audit Trail - Deleted Record
If Status = acDeleteOK Then
For i = 0 To UBound(Deleted, 2) - 1
With rst
.AddNew
!DateTimeMS = GetTimeUTC()
!UserID = TempVars.Item("CurrentUserID")
!ClientID = TempVars.Item("frmClientOpenID")
!RecordID = Deleted(2, i)
!ActionID = 3
!TableName = strTbl
!FieldName = Deleted(0, i)
!NewValue = Deleted(1, i)
.Update
End With
Next i
End If
rst.Close
Set rst = Nothing
Exit Sub
Err_Handler:
Select Case Err.Number
Case 3265
Resume Next 'Item not found in recordset
Case Else
'Unexpected Error
MsgBox "The following error has occurred" & vbCrLf & vbCrLf & "Error Number: " & _
Err.Number & vbCrLf & "Error Source: " & strSub & vbCrLf & "Error Description: " & _
Err.Description, vbExclamation, "An Error has Occured!"
End Select
rst.Close
Set rst = Nothing
End Sub
【讨论】:
以上是关于未绑定表单/文本框的审计跟踪的主要内容,如果未能解决你的问题,请参考以下文章