1

データベース内のフォームの監査追跡システムを設定しています。私はここでスーザンハーキンスからの例に従っています

私のコードは、customersテーブルに基づくフォームcustomersで機能します。これが私のコードです：

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

私のサブフォームは、3つのテーブルに基づくクエリに基づいています
ここに画像の説明を入力してください

Customer Productsで顧客価格を変更し、それらの変更のログを保持しようとしています。私が見逃しているものや回避策はありますか？

お手伝いありがとう！

4

1 に答える 1

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
于 2013-01-03T17:23:07.120 に答える