Click here to Skip to main content
15,879,068 members
Please Sign up or sign in to vote.
5.00/5 (1 vote)
I have an access database for employees.certain users from manager level has access to this databse. I want to log any changes (add new,edit,delete) to the databse using vba code.the users will be using forms to do the edits. I have tried using the below code,but the problem is that the below code works only for a standalone form. My forms contain sub forms and navigation forms.

What I have tried:

VB
Option Compare Database

Public Function auditchanges(recordid As String, useraction As String)
On Error GoTo auditerror
Dim DB As Database
Dim rst As Recordset
Dim clt As Control

Set DB = CurrentDb
Set rst = DB.OpenRecordset("select * from audittrail", adOpenDynamic)
userlogin = getuserlogon()
Select Case useraction
    Case "new"
        With rst
            .AddNew
            ![DateTime] = Now()
            ![username] = userlogin
            ![FormName] = Screen.ActiveForm.Name
            '![FormName] = Screen.ActiveForm.ActiveControl.Name
            ![Action] = useraction
            ![recordid] = Screen.ActiveForm.Controls(recordid).Value
            .Update
        End With
        
    Case "delete"
        With rst
            .AddNew
            ![DateTime] = Now()
            ![username] = userlogin
            ![FormName] = Screen.ActiveForm.Name
            '![FormName] = Screen.ActiveForm.ActiveControl.Name
            ![Action] = useraction
            ![recordid] = Screen.ActiveForm.Controls(recordid).Value
            .Update
        End With
        
    Case "edit"
         'For Each clt In Screen.ActiveForm.Controls
         For Each clt In Screen.ActiveForm.ActiveControl.Form
            If (clt.ControlType = acTextBox Or clt.ControlType = acComboBox) Then
                If Nz(clt.Value) <> Nz(clt.OldValue) Then
                    With rst
                        .AddNew
                        ![DateTime] = Now()
                        ![username] = userlogin
                        '![FormName] = Screen.ActiveForm.Name
                        ![FormName] = Screen.ActiveForm.ActiveControl.Form.Name
                        ![Action] = useraction
                        '![recordid] = Screen.ActiveForm.Controls(recordid).Value
                        '![recordid] = Screen.ActiveForm.ActiveControl.Form(recordid).Value
                        ![recordid] = Screen.ActiveForm.ActiveControl.Form(recordid).Value
                        ![FieldName] = clt.ControlSource
                        ![OldValue] = clt.OldValue
                        ![NewValue] = clt.Value
                        .Update
                    End With
                End If
             End If
        Next clt
        
End Select
rst.Close
DB.Close
Set rst = Nothing
Set DB = Nothing
auditerror:
    'MsgBox Err.Number & ":" & Err.Description, vbCritical, "Error"
    Exit Function
    
End Function
Posted
Updated 8-Oct-20 8:10am
v2
Comments
CHill60 30-Sep-20 6:28am    
Why can't you call the function from the sub-forms?
muneermohd9690 30-Sep-20 6:51am    
actually i am new to vb.this is a small project i am working on after watching so many youtube videos.so i don't know, is it possible to call the function from subform which i am trying to audit.if needed i can share the databse.
CHill60 30-Sep-20 6:57am    
You can't share the database anywhere I can access it from work.
Slight correction by the way - this is not VB, it's VBA. Similar, but yet a very different thing. Also, YouTube videos, unless presented as a consolidated course, are not a good way to learn a language.

Where are you calling the function from at the moment? Presumably your sub forms have "OK" buttons to indicate you want to commit the changes?
muneermohd9690 30-Sep-20 13:55pm    
https://www.dropbox.com/s/kaw7j17bheurs2x/empsystem_backup_270920201111111.accdb?dl=0

you can access the database using the above link.this was created on access 2019.i am calling the function from the subform where i need to do the auditing.yes i do have a save and delete button on the form.i need to audit any changes when save or delete pressed,which works actually when the form is opened as a a standalone form.but once i publish it to users they will only be able to access it using navigation forms which will contain the form as a sub form.adding a new record is on another form.later on i need to call the same function on this adding new record form as well.you can start from loginscreen form once you download the database.the username would be khalifa and password 1234.
CHill60 1-Oct-20 8:13am    
No. I cannot access the database using that link. As I said "You can't share the database anywhere I can access it from work."
Just put the call to the audit function in the code for the buttons save, delete, after you have done the save or the delete

1 solution

thank you all for all your suggestions. I have reached a solution on how to do it .below is the solution.you would create a global module and name it as auditchanges and insert the below code

VB
Option Compare Database
Option Explicit

Sub AuditChangesSub(recordid As String, UserAction As String)
On Error GoTo AuditChangesSub_Err
Dim cnn As ADODB.Connection
Dim rst As ADODB.Recordset
Dim ctl As Control
Dim userlogin As String
Set cnn = CurrentProject.Connection
Set rst = New ADODB.Recordset
rst.Open "SELECT * FROM audittrail", cnn, adOpenDynamic, adLockOptimistic
userlogin = getuserlogon()
Select Case UserAction
    Case "new"
        With rst
            .AddNew
            ![DateTime] = Now()
            ![UserName] = userlogin
            
            ![FormName] = Screen.ActiveControl.Parent.Form.Name
            ![Action] = UserAction
            ![recordid] = Screen.ActiveControl.Parent.Form(recordid).Value
            .Update
        End With
        
    Case "delete"
        With rst
            .AddNew
            ![DateTime] = Now()
            ![UserName] = userlogin
            
            ![FormName] = Screen.ActiveControl.Parent.Form.Name
            ![Action] = UserAction
            ![recordid] = Screen.ActiveControl.Parent.Form(recordid).Value
            .Update
        End With
        
    Case "edit"
         For Each ctl In Screen.ActiveControl.Parent.Controls
            If ctl.Tag = "Audit" Then
                If (ctl.ControlType = acTextBox Or ctl.ControlType = acComboBox) Then
                    If Nz(ctl.Value) <> Nz(ctl.OldValue) Then
                        With rst
                            .AddNew
                            ![DateTime] = Now()
                            ![UserName] = userlogin
                            ![FormName] = Screen.ActiveControl.Parent.Form.Name
                        
                            ![Action] = UserAction
                            ![recordid] = Screen.ActiveControl.Parent.Form(recordid).Value
                        
                            ![FieldName] = ctl.ControlSource
                            ![OldValue] = ctl.OldValue
                            ![NewValue] = ctl.Value
                            .Update
                        End With
                    End If
                End If
            End If
        Next ctl
    Case Else
            With rst
                .AddNew
                ![DateTime] = Now()
                ![UserName] = userlogin
                ![FormName] = Screen.ActiveControl.Parent.Form.Name
                ![Action] = UserAction
                ![recordid] = Screen.ActiveControl.Parent.Form(recordid).Value
                .Update
            End With
        
End Select
rst.Close
cnn.Close
Set rst = Nothing
Set cnn = Nothing
AuditChangesSub_Err:
    'MsgBox Err.Number & ":" & Err.Description, vbCritical, "Error"
    Exit Sub
    
End Sub

on the form which you want to audit the changes make sure you use the tag "Audit" on all the text boxes and combo boxes .and in the expression builder you will call the global function as below based on where you want to trigger the function,like for me below it is edit,delete and add new.
Option Compare Database
Option Explicit
Private Saved As Boolean



Private Sub clearbutton_Click()
DoCmd.GoToRecord , , acNewRec
End Sub

Private Sub cancel_Click()
Me.Undo
End Sub

Private Sub Combo131_BeforeUpdate(cancel As Integer)
If Combo131.Value = "HR" Then
    Call GetCount("HR")
        If hrcount = 7 Then
            MsgBox "you have already reached the limit, choose another department or will be assigned"
            cancel = True
            Me.Combo131.Undo
        End If
End If
If Combo131.Value = "IT" Then
    Call GetCount("IT")
        If itcount = 10 Then
            MsgBox "you have already reached the limit, choose another department or will be assigned"
            cancel = True
            Me.Combo131.Undo
        End If
End If
End Sub

Private Sub Form_BeforeUpdate(cancel As Integer)
Dim Response As Integer
If Saved = False Then
    Response = MsgBox("Do you want to save the changes on this record?", vbYesNo, "Save Changes?")
    If Response = vbNo Then
       Me.Undo
    End If
    
    Call AuditChangesSub("ID", "edit")
    
    Me.save.Enabled = False
End If
End Sub

Private Sub Form_Load()
Me.AllowEdits = False
End Sub

Private Sub showall_Click()
Dim strsearch As String
Call edit_Click
strsearch = "SELECT * from trainingperiod "
Me.RecordSource = strsearch
Me.txtsearch.Value = ""

End Sub

Private Sub search_Click()
Dim strsearch As String
Dim strtext As String
strtext = Me.txtsearch.Value
strsearch = "SELECT * from trainingperiod where([full name] like ""*" & strtext & "*"" or [employee id] like ""*" & strtext & "*"")"
Me.RecordSource = strsearch
Me.txtsearch.Value = ""

End Sub

Private Sub save_Click()
    Call AuditChangesSub("ID", "edit")
    Saved = True
    DoCmd.RunCommand (acCmdSaveRecord)
    Me.save.Enabled = False
    Saved = False
End Sub

Private Sub edit_Click()
Me.AllowEdits = True
End Sub

Private Sub delete_Click()
    
    Dim strsearch As String
    Dim strtext As String
    strtext = (Me.txtsearch.Value)
    If IsNull(Me.txtsearch.Value) Then
         'strtext = Me.CurrentRecord
         Call edit_Click
         If MsgBox("are you sure you want to delete the record", vbYesNo) = vbYes Then
            DoCmd.SetWarnings False
             Call AuditChangesSub("ID", "delete")
            DoCmd.RunCommand acCmdDeleteRecord
            Me.Requery
           
            
        End If
    ElseIf MsgBox("are you sure you want to delete the record", vbYesNo) = vbYes Then
        'strsearch = "DELETE * from trainingperiod where [employee id]= '" + strtext + "'"
        DoCmd.SetWarnings False
        Call AuditChangesSub("ID", "delete")
        DoCmd.RunCommand acCmdDeleteRecord
        Me.Requery
        
        
    End If
    Me.txtsearch.Value = ""
    
End Sub
Private Sub Form_Unload(cancel As Integer)
    Me.Undo
End Sub

Private Sub Form_Error(DataErr As Integer, Response As Integer)
    If DataErr = 2169 Then
        Response = True
    End If
End Sub

Private Sub txtsearch_Click()
    Call edit_Click
End Sub

Private Sub Form_Dirty(cancel As Integer)
    Me.save.Enabled = True
End Sub
 
Share this answer
 
v3
Comments
CHill60 9-Oct-20 8:46am    
It would be nice if you had actually shared what that solution was
muneermohd9690 12-Oct-20 11:18am    
i have sumbitted the solution
CHill60 12-Oct-20 11:57am    
I notice someone has downvoted you without explaining why. I feel that is a little harsh given that I asked you to share the solution, so I have upvoted this with a 5
muneermohd9690 12-Oct-20 13:44pm    
thanks for the vote CHill60.if anyone needs more explanation for the solution,i would like to help.

This content, along with any associated source code and files, is licensed under The Code Project Open License (CPOL)



CodeProject, 20 Bay Street, 11th Floor Toronto, Ontario, Canada M5J 2N8 +1 (416) 849-8900