審計跟蹤表單

Question

我正在爲我的數據庫中的表單設置審計跟蹤系統。我正在關注Susan Harkins的示例Here

我的代碼適用於基於客戶表的我的表單客戶。這裏是我的代碼：

Const cDQ As String = """" 
Sub AuditTrail(frm As Form, recordid As Control) 
'Track changes to data. 
'recordid identifies the pk field's corresponding 
'control in frm, in order to id record. 
Dim ctl As Control 
Dim varBefore As Variant 
Dim varAfter As Variant 
Dim strControlName As String 
Dim strSQL As String 
On Error GoTo ErrHandler 
'Get changed values. 
For Each ctl In frm.Controls 
With ctl 
'Avoid labels and other controls with Value property. 
If .ControlType = acTextBox Then 
If .Value <> .OldValue Then 
MsgBox "Step 1" 
varBefore = .OldValue 
varAfter = .Value 
strControlName = .Name 
'Build INSERT INTO statement. 
strSQL = "INSERT INTO " _ 
& "Audit (EditDate, User, RecordID, SourceTable, " _ 
& " SourceField, BeforeValue, AfterValue) " _ 
& "VALUES (Now()," _ 
& cDQ & Environ("username") & cDQ & ", " _ 
& cDQ & recordid.Value & cDQ & ", " _ 
& cDQ & frm.RecordSource & cDQ & ", " _ 
& cDQ & .Name & cDQ & ", " _ 
& cDQ & varBefore & cDQ & ", " _ 
& cDQ & varAfter & cDQ & ")" 
'View evaluated statement in Immediate window. 
Debug.Print strSQL 
DoCmd.SetWarnings False 
DoCmd.RunSQL strSQL 
DoCmd.SetWarnings True 
End If 
End If 
End With 
Next 
Set ctl = Nothing 
Exit Sub 
ErrHandler: 
MsgBox Err.Description & vbNewLine _ 
& Err.Number, vbOKOnly, "Error" 
End Sub 

然而，當我嘗試的形式我得到一個錯誤「操作不支持這種類型的對象」內子窗體我改變的數據。我能看到的錯誤是發生在這裏：

If .Value <> .OldValue Then 

我的子窗體基於斷這是基於關閉三個表

我想改變下客戶產品顧客的價格查詢並保存這些更改的日誌。有什麼我失蹤或工作。

謝謝你的幫助！

Answer 1

暫時禁用錯誤處理程序是這樣的：

'On Error GoTo ErrHandler 

當您收到「不支持操作」的錯誤通知，從錯誤對話框中選擇調試。這將允許您找出有關觸發錯誤的當前文本框控件的更多信息。嘗試在立即窗口中下面的語句：

? ctl.Name 
? ctl.ControlSource 
? ctl.Enabled 
? ctl.Locked 
? ctl.Value 

至少ctl.Name將識別文本框觸發錯誤。

檢查db後，我會建議一個函數（IsOldValueAvailable）來指示.OldValue是否可用於當前控件。使用該功能，AuditTrail程序在此更改後工作：

'If .ControlType = acTextBox Then 
If IsOldValueAvailable(ctl) = True Then 

並且該函數。它可能還需要更多的工作，但我沒有發現我的測試有任何問題。

Public Function IsOldValueAvailable(ByRef ctl As Control) As Boolean 
    Dim blnReturn As Boolean 
    Dim strPrompt As String 
    Dim varOldValue As Variant 

On Error GoTo ErrorHandler 

    Select Case ctl.ControlType 
    Case acTextBox 
     varOldValue = ctl.OldValue 
     blnReturn = True 
    Case Else 
     ' ignore other control types; return False 
     blnReturn = False 
    End Select 

ExitHere: 
    On Error GoTo 0 
    IsOldValueAvailable = blnReturn 
    Exit Function 

ErrorHandler: 
    Select Case Err.Number 
    Case 3251 ' Operation is not supported for this type of object. 
     ' pass 
    Case Else 
     strPrompt = "Error " & Err.Number & " (" & Err.Description _ 
      & ") in procedure IsOldValueAvailable" 
     MsgBox strPrompt, vbCritical, "IsOldValueAvailable Function Error" 
    End Select 
    blnReturn = False 
    Resume ExitHere 
End Function