Subform - Before Update Event

Bobbinbobwhite

Registered User.
Local time
Today, 15:48
Joined
Jan 24, 2017
Messages
17
I have a bound parent form with a bound sub-form embedded. All created with the Access 2010 wizard. I have created 2 audit modules to track new, edit & deleted transactions on the sub-form.

I have added before update, on delete and after Del Confirm events to the sub-form. When I open the sub-form and enter, edit or delete data the module runs perfectly. However when I open the parent form with the sub-form embedded, the events do not work. I either get an error that the operation is not supported by this type of object or the module is unable to find the key field on the sub-form, or no errors but the audit table is not updated.

I use these events on some other forms, without a sub-form embedded, and they work fine. I am sure I am missing an important piece of info on how sub-forms work.

Any suggestions on how to resolve my issue? I would consider myself a beginner with VBA, but pretty comfortable with Access. Most of the VBA code I have for the audit tracking is from on-line posts and a lot from this forum. As far as using the Debug in the VBA window of access, it doesn't trigger when the module is called and I haven't been able to figure out how to use it for a called procedure.

Thank you in advance for all of your help!!
 
I don't have any code on main/parent form that references the sub-form, I am triggering everything from the sub-form.

Event code on sub-form "Balances Bank Entry subform"

Private Sub Form_BeforeUpdate(Cancel As Integer)
If Me.NewRecord Then
Call AuditChanges("Balance_ID", "NEW")
Else
Call AuditChanges("Balance_ID", "EDIT")
End If
End Sub

Private Sub Form_Delete(Cancel As Integer)
If Status = acDeleteOK Then Call AuditDelete("Balance_ID", "DELETE")
End Sub
Private Sub Form_AfterDelConfirm(Status As Integer)
If Status = acDeleteOK Then
CurrentDb.QueryDefs("qryAuditAppend").Execute
CurrentDb.QueryDefs("qryAuditDelete").Execute
End If
End Sub


Module - basAudit:
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 = Environ("USERNAME")
Dim frmCurrentForm As Form
Set frmCurrentForm = Screen.ActiveForm
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
![FormName] = frmCurrentForm.Name
![RecordID] = frmCurrentForm(IDField).Value
![Action] = UserAction
![DateTime] = datTimeCheck
![UserName] = strUserID
![FieldName] = ctl.ControlSource
![OldValue] = ctl.OldValue
![NewValue] = ctl.Value
.Update
End With
End If
End If
Next ctl
Case Else
For Each ctl In Screen.ActiveForm.Controls
If ctl.Tag = "Audit" Then
With rst
.AddNew
![FormName] = frmCurrentForm.Name
![RecordID] = frmCurrentForm(IDField).Value
![Action] = UserAction
![DateTime] = datTimeCheck
![UserName] = strUserID
![FieldName] = ctl.ControlSource
![NewValue] = ctl.Value
.Update
End With
End If
Next ctl
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


Module - basDelete:
Option Compare Database
Sub AuditDelete(IDField As String, UserAction As String)
On Error GoTo AuditDelete_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 tblAuditDelete", cnn, adOpenDynamic, adLockOptimistic
datTimeCheck = Now()
strUserID = Environ("USERNAME")
Dim frmCurrentForm As Form
Set frmCurrentForm = Screen.ActiveForm
Select Case UserAction
Case "DELETE"
For Each ctl In Screen.ActiveForm.Controls
If ctl.Tag = "Audit" Then
With rst
.AddNew
![FormName] = frmCurrentForm.Name
![RecordID] = frmCurrentForm(IDField).Value
![Action] = UserAction
![DateTime] = datTimeCheck
![UserName] = strUserID
![FieldName] = ctl.ControlSource
![OldValue] = ctl.OldValue
![NewValue] = ctl.Value
.Update
End With
End If
Next ctl
Case Else
End Select
AuditDelete_Exit:
On Error Resume Next
rst.Close
cnn.Close
Set rst = Nothing
Set cnn = Nothing
Exit Sub
AuditDelete_Err:
MsgBox Err.Description, vbCritical, "ERROR!"
Resume AuditDelete_Exit
End Sub
 
Rather than use Screen.ActiveForm in the module code...
Code:
Dim frmCurrentForm As Form
Set frmCurrentForm = Screen.ActiveForm
...it would be far more precise if you pass a reference of the form in question directly to the routine. Consider a method signature like...
Code:
Sub AuditChanges(frm As Access.Form, IDField As String, UserAction As String)
...with calling code like...
Code:
Private Sub Form_BeforeUpdate(Cancel As Integer)
   If Me.NewRecord Then
      Call AuditChanges(Me, "Balance_ID", "NEW")
   Else
      Call AuditChanges(Me, "Balance_ID", "EDIT")
   End If
End Sub

Private Sub Form_Delete(Cancel As Integer)
   If Status = acDeleteOK Then Call AuditDelete(Me, "Balance_ID", "DELETE")
End Sub
This way we pass the form in question directly to the audit code, which is far more reliable.

Hope this helps,
 
Sorry it has been a while, I got pulled into another project.

I have made the suggested changes and still can't seem to get the subforms to run the events when they are embedded on a main form. The events all work when I open the subform independently.

I attached a copy of the DB hoping that would help....

From the main switchboard, select data entry then Bank - Quarterly Loan Balances or Bank Transactions

After entering a new record, changing an existing record or deleting a record, open the table tblAuditTrail, each field added, changed or deleted should be added as a record in this table.

The subform on each of these forms do not seem to be triggering the before update events.
 

Attachments

Last edited:
I just realized my subforms are in datasheet view.... could this be part of the problem?
 
I changes one of the subforms to continuous and the event doesn't seem to trigger from the main form, but did trigger when I opened the subform independently.
 
Looked at your db but can't find how to cause this problem. All events ran fine.
 
ActiveForm is the main form so the control loop is acting on it rather than the subform.
 
How can the main form be the active form, when the data entry is done on the sub form?

I am opening and looking at the table named tblAuditTrail after an entry to see if it recorded the activity in that table.

On the form Bank Balance Entry, on the sub-form enter a new record. From the switchboard click data entry, Bank-Quarterly Loan Balances (opens form Bank Balance Entry), this will open thesub-form Balances Bank Entry subform embedded on the main form. After entering a new record, changing an existing record or deleting a record, on the subform open the table tblAuditTrail, each field added, changed or deleted should be added as a record in this table.
 
Last edited:
I've looked closer and the problem is that you are still using ActiveForm in your code. This is the signature of your audit routine...
Code:
Sub AuditChanges(frm As Access.Form, IDField As String, UserAction As String)
...and you do correctly pass in the subform reference, but later in your audit routine you do this...
Code:
    Dim frmCurrentForm As Form
    Set frmCurrentForm = [COLOR="Blue"]Screen.ActiveForm[/COLOR]
    Select Case UserAction
        Case "EDIT"
            For Each ctl In [COLOR="Blue"]Screen.ActiveForm[/COLOR].Controls
                If ctl.Tag = "Audit" Then
                    If Nz(ctl.Value) <> Nz(ctl.OldValue) Then
                        With rst
                            .AddNew
                            ![FormName] = [COLOR="Blue"]frmCurrentForm[/COLOR].Name
                            ![RecordID] = [COLOR="Blue"]frmCurrentForm[/COLOR](IDField).Value
...so you have passed a valid subform reference to the Audit routine, but you have not used it. Replace all the ActiveForm references in the audit routine to leverage the form you pass in. So the code should look like...
Code:
    Select Case UserAction
        Case "EDIT"
            For Each ctl In [COLOR="Blue"]frm[/COLOR].Controls
                If ctl.Tag = "Audit" Then
                    If Nz(ctl.Value) <> Nz(ctl.OldValue) Then
                        With rst
                            .AddNew
                            ![FormName] = [COLOR="Blue"]frm[/COLOR].Name
                            ![RecordID] = [COLOR="Blue"]frm[/COLOR](IDField).Value
Hope that helps,
 
THANK YOU!!!!
I knew it was something simple that I was missing, and no knowing enough to find it!

It all seems to be working now, you are all AMAZING!!
 
So I got my auditing to work with this fix. But I get an error on the parent form when I click the next record icon or use tab to move to the next record after editing a field. The error I get is "operation is not supported for this type of object". I original thought it was because one of the fields used rich text. I checked the fields on the parent form and every is using plain text and so if the associated tables. I am not sure what else could be causing the issue. Ideas? Auditing appears to be working just fine for the fields being audited. But this error only started after I added the auditing.
 
Hey Joe, welcome to the forum.

Is there code associated with this error? Does a window pop up with a debug option?
 
No Debug option. Just a pop box that states the operation not supported.
 
I was getting this error on one of my main forms too. I removed the audit tag from the Attachment field on that form and I no longer receive the error.
 
Yeah double checked them, had to remove to but it did not make a difference. I also checked for hyperlink fields. Going to see if I can add a message box to audit code to see if give me a better idea of where and when.
 
Ok So I ocmmented out the error handling and get error code 3251 for this line in the audit code: If Nz(ctl.Value) <> Nz(ctl.OldValue) Then

Audit module code:

Sub AuditChanges(frm As Access.Form, ID 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
'Dim frmCurrentForm As Form
'Set frmCurrentForm = Screen.ActiveForm
Set cnn = CurrentProject.Connection
Set rst = New ADODB.Recordset
rst.Open "SELECT * FROM tbl_Auditing", cnn, adOpenDynamic, adLockOptimistic
datTimeCheck = Now()
strUserID = Environ("USERNAME")
Select Case UserAction
Case "EDIT"
For Each ctl In frm.Controls
'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] = frm.Name
![Action] = UserAction
![RecordID] = frm(ID).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] = frm.Name
![Action] = UserAction
![RecordID] = frm(ID).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



Event code in the forms:
Private Sub Form_AfterDelConfirm(Status As Integer)
If Status = acDeleteOK Then Call AuditChanges(Me, "ID", "DELETE")
End Sub


Private Sub Form_BeforeUpdate(Cancel As Integer)
If Me.NewRecord Then
Call AuditChanges(Me, "ID", "NEW")
Else
Call AuditChanges(Me, "ID", "EDIT")
End If
End Sub

Private Sub Form_Close()
Forms![Navigation Form].Requery
End Sub
 

Users who are viewing this thread

Back
Top Bottom