Last Modified date added to subform record

A

acarterczyz

Registered User.
Local time
Today, 16:16
Joined
Apr 11, 2013
Messages
68
I have a subform that is filtered by a textbox on the main form. Is there any way I can add a timestamp to a record on the subform when a user changes anything on that record?

I've tried the Macro that is listed on Microsoft's website regarding timestamps, but I had serious issues implementing that to a subform.
 
If a change occurs you trap it in the Before Update event (I'll explain why) and the After Update event.

Before Update:
1. Check that the record is not a new record using the form's NewRecord property. Obviously a new record is not a change in a record.
2. If it isn't a new record, set a boolean variable to True to confirm that a change is about to occur

After Update:
3. Check the boolean variable from step 2 to see if a change occured
4. Run an UPDATE statement to put a date/time stamp on the record using Now()
 
vbaInet said:
If a change occurs you trap it in the Before Update event (I'll explain why) and the After Update event.

Before Update:
1. Check that the record is not a new record using the form's NewRecord property. Obviously a new record is not a change in a record.
2. If it isn't a new record, set a boolean variable to True to confirm that a change is about to occur

After Update:
3. Check the boolean variable from step 2 to see if a change occured
4. Run an UPDATE statement to put a date/time stamp on the record using Now()
Click to expand...

Well the issue is that the filtered subform will contain many records and I only want to mark the changed ones as modified (not all the records in that filtered subform).
 
If there's a step you don't understand please ask.
What step do you not understand or what step do you think contradicts your objective? Have you actually tried what I suggested?
 
vbaInet said:
If there's a step you don't understand please ask.
What step do you not understand or what step do you think contradicts your objective? Have you actually tried what I suggested?
Click to expand...

Actually, what I don't understand is how to implement it. I'm still a newbie when it comes to coding. The user wouldn't be entering a new record, so that portion wouldn't be necessary. What I've gotten thus far has been somewhat complex. The user opens the database, enters some information into the main form and it filters a subform after they hit "Go". They are then able to edit some information in that subform, click a button and it emails it to me through Outlook. The only piece missing in the puzzle is identifying what has changed.
 
You want to mark an entire record as changed? Not on a field level right?
 
Have you looked through the Sample Databases on the forum? There's an Audit Trail database here.
 
Of course I would have never thought to look through the sample databases :) I didn't know it was called Audit Trail. I've implemented it and it works like a charm. THANK YOU!!

For any future viewers who are looking for the code, here it is. Just create a table called tblAudit with the following fields (Audit_ID, User, DateTime, UniqID_Field, UniqID, Form, Field, Prev_Value, New_Value, Action, Reason, DelValues). Create two modules:

AuditTrail:
Code: 
Option Compare Database
Option Explicit

Public Function Audit_Trail(MyForm As Form, UniqID_Field As String, UniqID As String)
On Error GoTo Err_Audit_Trail
    
'ACC2000: How to Create an Audit Trail of Record Changes in a Form
'http://support.microsoft.com/default.aspx?scid=kb;en-us;197592
    
    'Dim MyForm As Form
    Dim ctl As Control
    Dim ccnt As Control
    Dim sUser As String
    
    Dim strSQL As String
    Const cQUOTE = """" 'Thats 2 quotes in sequence
        
    Dim action, nullval As String
    nullval = "Null"
    
    sUser = Environ("UserName") 'get the users login name
    
    'If new record, record it in audit trail and exit function.
    If MyForm.NewRecord = True Then
        action = "*** New Record ***"
        'Broken down into 4 separate variables for ease of view and troubleshooting
        strSQL = "INSERT INTO tblAudit ( [User], [DateTime], UniqID_Field, UniqID, Form, [Action])"
        strSQL = strSQL & " SELECT " & cQUOTE & sUser & cQUOTE & ", " & cQUOTE & Now & cQUOTE & " , "
        strSQL = strSQL & cQUOTE & UniqID_Field & cQUOTE & ", " & cQUOTE & UniqID & cQUOTE & ", "
        strSQL = strSQL & cQUOTE & MyForm.Name & cQUOTE & ", " & cQUOTE & action & cQUOTE & ";"
        
        DoCmd.SetWarnings False
        DoCmd.RunSQL strSQL
        DoCmd.SetWarnings True
        
        Exit Function
    End If
    
    Dim changecnt As Integer
    changecnt = 0
    
    'Check each data entry control for change and record old value of the control.
    For Each ccnt In MyForm.Controls
    
    Select Case ccnt.ControlType
      Case acTextBox, acComboBox, acListBox, acOptionGroup, acCheckBox
        If ccnt.Name Like "*" & "txt" & "*" Then GoTo TryNextCCNT   'Skip AuditTrail field.
        If (ccnt.Value <> ccnt.OldValue) Or _
           (IsNull(ccnt.Value) And Len(ccnt.OldValue) > 0 Or ccnt.Value = "" And Len(ccnt.OldValue) > 0) Then
          changecnt = changecnt + 1
        End If
    End Select
    
TryNextCCNT:
  Next ccnt
        
    If changecnt > 0 Then
      gstrReason = InputBox("Reason for change(s)?", "Reason for change(s)?")
    End If
        
    'Check each data entry control for change and record old value of the control.
    For Each ctl In MyForm.Controls
        
    'Only check data entry type controls.
    Select Case ctl.ControlType
    Case acTextBox, acComboBox, acListBox, acOptionGroup, acCheckBox
        If ctl.Name Like "*" & "txt" & "*" Then GoTo TryNextControl 'Skip AuditTrail field.
        If ctl.Value <> ctl.OldValue Then
            action = "*** Updated Record ***"
        
            'Broken down into 4 separate variables for ease of view and troubleshooting
            strSQL = "INSERT INTO tblAudit ( [User], [DateTime], UniqID_Field, UniqID, Form, Field, Prev_Value, New_Value, [Action], Reason)"
            strSQL = strSQL & " SELECT " & cQUOTE & sUser & cQUOTE & ", " & cQUOTE & Now & cQUOTE & " , "
            strSQL = strSQL & cQUOTE & UniqID_Field & cQUOTE & ", " & cQUOTE & UniqID & cQUOTE & ", "
            strSQL = strSQL & cQUOTE & MyForm.Name & cQUOTE & ", " & cQUOTE & ctl.Name & cQUOTE & ", " & cQUOTE & ctl.OldValue & cQUOTE
            strSQL = strSQL & ", " & cQUOTE & ctl.Value & cQUOTE & ", " & cQUOTE & action & cQUOTE & ", " & cQUOTE & gstrReason & cQUOTE & ";"
            
            DoCmd.SetWarnings False
            DoCmd.RunSQL strSQL
            DoCmd.SetWarnings True
            
        'If old value is Null and new value is not Null
        ElseIf IsNull(ctl.OldValue) And Len(ctl.Value) > 0 Or ctl.OldValue = "" And Len(ctl.Value) > 0 Then
            action = "*** Added Info to Record ***"
        
            'Broken down into 4 separate variables for ease of view and troubleshooting
             strSQL = "INSERT INTO tblAudit ( [User], [DateTime], UniqID_Field, UniqID, Form, Field, Prev_Value, New_Value, [Action])"
             strSQL = strSQL & " SELECT " & cQUOTE & sUser & cQUOTE & ", " & cQUOTE & Now & cQUOTE & " , "
             strSQL = strSQL & cQUOTE & UniqID_Field & cQUOTE & ", " & cQUOTE & UniqID & cQUOTE & ", "
             strSQL = strSQL & cQUOTE & MyForm.Name & cQUOTE & ", " & cQUOTE & ctl.Name & cQUOTE & ", " & cQUOTE & nullval & cQUOTE
             strSQL = strSQL & ", " & cQUOTE & ctl.Value & cQUOTE & ", " & cQUOTE & action & cQUOTE & ";"
             
             DoCmd.SetWarnings False
             DoCmd.RunSQL strSQL
             DoCmd.SetWarnings True
             
        'If new value is Null and old value is not Null
        ElseIf IsNull(ctl.Value) And Len(ctl.OldValue) > 0 Or ctl.Value = "" And Len(ctl.OldValue) > 0 Then
             action = "*** Removed Info to Record ***"

            'Broken down into 4 separate variables for ease of view and troubleshooting
             strSQL = "INSERT INTO tblAudit ( [User], [DateTime], UniqID_Field, UniqID, Form, Field, Prev_Value, New_Value, [Action], Reason)"
             strSQL = strSQL & " SELECT " & cQUOTE & sUser & cQUOTE & ", " & cQUOTE & Now & cQUOTE & " , "
             strSQL = strSQL & cQUOTE & UniqID_Field & cQUOTE & ", " & cQUOTE & UniqID & cQUOTE & ", "
             strSQL = strSQL & cQUOTE & MyForm.Name & cQUOTE & ", " & cQUOTE & ctl.Name & cQUOTE & ", " & cQUOTE & ctl.OldValue & cQUOTE
             strSQL = strSQL & ", " & cQUOTE & nullval & cQUOTE & ", " & cQUOTE & action & cQUOTE & ", " & cQUOTE & gstrReason & cQUOTE & ";"
             
             DoCmd.SetWarnings False
             DoCmd.RunSQL strSQL
             DoCmd.SetWarnings True
         End If

    End Select
    
TryNextControl:
    Next ctl
    
Exit_Audit_Trail:
    Exit Function
    
Err_Audit_Trail:
    If Err.Number = 2001 Then 'You canceled the previous operation.
      'do nothing
    Else
        Beep
        MsgBox Err.Number & " - " & Err.Description
    End If
    Resume Exit_Audit_Trail
    
End Function

DeleteAudit:
Code: 
Option Compare Database
Option Explicit

Public gstrReason      As String

Public Function Delete_Rec(MyForm As Form, UniqID_Field As String, UniqID As String)
On Error GoTo Err_Delete_Rec

    MyForm.AllowEdits = True
    MyForm.AllowDeletions = True

    If MsgBox("Are you sure you want to delete this record", vbYesNo, "Delete this record?") = vbYes Then
        Dim ctl As Control
        Dim sUser As String
        Dim delvals As String
        
        Dim strSQL As String
        Const cQUOTE = """" 'That is 2 quotes in sequence
            
        Dim action As String
        action = "*** Record Deleted ***"
               
        sUser = Environ("UserName") 'get the users login name
                                              
        'Check each data entry control for change and record old value of the control.
        For Each ctl In MyForm.Controls
            'Only check data entry type controls.
            Select Case ctl.ControlType
                Case acTextBox, acComboBox, acListBox, acOptionGroup, acCheckBox
                If ctl.Name Like "*" & "txt" & "*" Then GoTo TryNextControl 'Skip AuditTrail field.
                If Len(ctl.Value) > 0 Then delvals = delvals & "| " & ctl.Name & " = " & ctl.Value & " "
            End Select
            
TryNextControl:
Next ctl
                       
        'Broken down into 4 separate variables for ease of view and troubleshooting
        strSQL = "INSERT INTO tblAudit ( [User], [DateTime], UniqID_Field, UniqID, Form, [Action], Reason, DelValues)"
        strSQL = strSQL & " SELECT " & cQUOTE & sUser & cQUOTE & ", " & cQUOTE & Now & cQUOTE & " , "
        strSQL = strSQL & cQUOTE & UniqID_Field & cQUOTE & ", " & cQUOTE & UniqID & cQUOTE & ", "
        strSQL = strSQL & cQUOTE & MyForm.Name & cQUOTE & ", " & cQUOTE & action & cQUOTE & ", " & "[Reason for change] AS Expr1" & ", "
        strSQL = strSQL & cQUOTE & delvals & cQUOTE & ";"
                
        DoCmd.SetWarnings False
        DoCmd.RunSQL strSQL
        DoCmd.SetWarnings True
        
        DoCmd.SetWarnings False
        DoCmd.DoMenuItem acFormBar, acEditMenu, 8, , acMenuVer70
        DoCmd.DoMenuItem acFormBar, acEditMenu, 6, , acMenuVer70
        DoCmd.SetWarnings True
        
    End If
    
    
    MyForm.AllowEdits = False
    MyForm.AllowDeletions = False
    
Exit_Delete_Rec:
    Exit Function
    
Err_Delete_Rec:
        Beep
        MsgBox Err.Number & " - " & Err.Description
        'Resume Exit_Delete_Rec
        Exit Function
End Function

And call these in the subform:
Code: 
Option Compare Database
Option Explicit

Private Sub Form_BeforeUpdate(Cancel As Integer)
    Audit_Trail Me, "Expense Number", Me.Expense_Number
End Sub

Private Sub Form_Delete(Cancel As Integer)
    Delete_Rec Me, "Expense Number", Me!Expense_Number
End Sub
 
Good to hear! Might be helpful to place a link to the thread as well.
 
You must log in or register to reply here.

Similar threads

D
Solved Subform adding blank record
Replies
16
Views
346
dullster
D
D
Subform requery is starting a new record
Replies
4
Views
330
dullster
D
C
Solved No Current Record on Access Close
Replies
11
Views
599
Pat Hartman
P
D
After update
Replies
17
Views
487
Pat Hartman
P
C
Subform Footer Textbox wont update
Replies
11
Views
281
Pat Hartman
P

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Back
Top Bottom