Solution for one who needs with simple code and applying into access database to track for all changes and adding new records or deleting records from main form and subform. If we need to record any change that happens to any record from a main form that links to a subform by one-to-many relationship. Both changes happen from main from and subform will be also recorded. Theory is to create a table that stores all changes done by User "computername" and date when it happen, and on form where data have been changed, in addition the second, minute, and date also recorded in primary key and when creating Key for the recording table.
Details instruction on step by step implementation:
For the mainform:
Step 1. Creating table to keep all changes
The table contains following fields
Table name: canregnotes
Variable contained in "canregnotes":
msbenhnhan: Primary key of the record to be tracked
tenbien: Name of the variable to be recorded
myoldval: Old value is the value before the change
mynewval: New value: value after change
chngdate: the date of change
madeby: The computer name that used to change
onfrmName: The form where changed happened
Step 2. Create a module that contains this following Function for mainform
Step 3. Call the function on Before Update event
For the subform
Step 1. Copy and past the following code to VBA open from the subform
Step 2. Call the Sub on Before Update
Save, Close and Reopen Form again, enjoy!.
Tuan.
Details instruction on step by step implementation:
For the mainform:
Step 1. Creating table to keep all changes
The table contains following fields
Table name: canregnotes
Variable contained in "canregnotes":
msbenhnhan: Primary key of the record to be tracked
tenbien: Name of the variable to be recorded
myoldval: Old value is the value before the change
mynewval: New value: value after change
chngdate: the date of change
madeby: The computer name that used to change
onfrmName: The form where changed happened
Step 2. Create a module that contains this following Function for mainform
Code:
Public Function DTrackChanges()
Dim ActiveForm As Form
Dim Actrl As Control
Dim UserId As String
'Dim ActivSubForm As Form
'Set ActivSubForm = Screen.ActiveControl.Parent
' Then to use that pointer to get the name
'MsgBox ActivSubForm.Name
'Dim sbfrmName As String
'sbfrmName = "canregsub"
Dim frmName As String
Set ActiveForm = Screen.ActiveForm
frmName = ActiveForm.Name
UserId = Environ$("computername")
If ActiveForm.NewRecord = True Then
CurrentDb.Execute "INSERT INTO canregnotes(msbenhnhan, tenbien, myoldval, mynewval, chngdate, madeby, onfrmName) VALUES ('" & Forms(frmName)!identry.Value & Format(Now(), "hhmmssddmmyyyy") & Int((999 - 100 + 1) * Rnd + 100) & "','" & "New Record" & "','" & "New Record" & "', '" & "New Record added on " & Now & "', '" & Format(Now(), "dd/mm/yyyy") & "', '" & "by " & UserId & "', '" & frmName & "')"
DoCmd.SetWarnings False
Exit Function
End If
For Each Actrl In ActiveForm.Controls
Select Case Actrl.ControlType
Case acTextBox, acComboBox, acListBox, acOptionGroup, acCheckBox
If Actrl.Value <> Actrl.OldValue Then
CurrentDb.Execute "INSERT INTO canregnotes(msbenhnhan, tenbien, myoldval, mynewval, chngdate, madeby, onfrmName) VALUES ('" & Forms(frmName)!identry.Value & Format(Now(), "hhmmssddmmyyyy") & Int((999 - 100 + 1) * Rnd + 100) & "','" & Actrl.Name & "' ,'" & Actrl.OldValue & "', '" & Actrl.Value & "', '" & Format(Now(), "dd/mm/yyyy") & "', '" & "by " & UserId & "', '" & frmName & "')"
DoCmd.SetWarnings False
ElseIf IsNull(Actrl.OldValue) And Len(Actrl.Value) > 0 Or Actrl.OldValue = "" And Len(Actrl.Value) > 0 Then
CurrentDb.Execute "INSERT INTO canregnotes(msbenhnhan, tenbien, myoldval, mynewval, chngdate, madeby, onfrmName) VALUES ('" & Forms(frmName)!identry.Value & Format(Now(), "hhmmssddmmyyyy") & Int((999 - 100 + 1) * Rnd + 100) & "','" & Actrl.Name & "' ,'" & "Null" & "', '" & Actrl.Value & "', '" & Format(Now(), "dd/mm/yyyy") & "', '" & "by " & UserId & "', '" & frmName & "')"
DoCmd.SetWarnings False
ElseIf IsNull(Actrl.Value) And Len(Actrl.OldValue) > 0 Or Actrl.Value = "" And Len(Actrl.OldValue) > 0 Then
CurrentDb.Execute "INSERT INTO canregnotes(msbenhnhan, tenbien, myoldval, mynewval, chngdate, madeby, onfrmName) VALUES ('" & Forms(frmName)!identry.Value & Format(Now(), "hhmmssddmmyyyy") & Int((999 - 100 + 1) * Rnd + 100) & "','" & Actrl.Name & "' ,'" & Actrl.OldValue & "', '" & "Null" & "', '" & Format(Now(), "dd/mm/yyyy") & "', '" & "by " & UserId & "', '" & frmName & "')"
DoCmd.SetWarnings False
End If
End Select
TryNextControl:
Next Actrl
Exit_DTrackChanges:
Exit Function
End Function
Step 3. Call the function on Before Update event
Code:
Private Sub Form_BeforeUpdate(Cancel As Integer)
Call DTrackChanges
End Sub
For the subform
Step 1. Copy and past the following code to VBA open from the subform
Code:
Sub SubDTrackChanges()
Dim ActiveSubForm As Form
Dim Actrlsub As Control
Dim UserIdsub As String
'Dim ActivSubForm As Form
'Set ActivSubForm = Screen.ActiveControl.Parent
' Then to use that pointer to get the name
'MsgBox ActivSubForm.Name
'Dim sbfrmName As String
'sbfrmName = "canregsub"
'Dim frmName As String
Set ActiveSubForm = Screen.ActiveControl.Parent.Form
'frmName = ActiveSubForm.Name
UserIdsub = Environ$("computername")
If ActiveSubForm.NewRecord = True Then
CurrentDb.Execute "INSERT INTO canregnotes(msbenhnhan, tenbien, myoldval, mynewval, chngdate, madeby, onfrmName) VALUES ('" & Screen.ActiveControl.Parent.Form.Controls("identry").Value & Screen.ActiveControl.Parent.Form.Controls("dtpmkey").Value & Format(Now(), "hhmmssddmmyyyy") & Int((999 - 100 + 1) * Rnd + 100) & "','" & "New Record" & "','" & "New Record" & "', '" & "New Record added on " & Now & "', '" & Format(Now(), "dd/mm/yyyy") & "', '" & "by " & UserIdsub & "', '" & Screen.ActiveControl.Parent.Form.Name & "')"
DoCmd.SetWarnings False
Exit Sub
End If
For Each Actrlsub In ActiveSubForm.Controls
Select Case Actrlsub.ControlType
Case acTextBox, acComboBox, acListBox, acOptionGroup, acCheckBox
If Actrlsub.Value <> Actrlsub.OldValue Then
CurrentDb.Execute "INSERT INTO canregnotes(msbenhnhan, tenbien, myoldval, mynewval, chngdate, madeby, onfrmName) VALUES ('" & Screen.ActiveControl.Parent.Form.Controls("identry").Value & Screen.ActiveControl.Parent.Form.Controls("dtpmkey").Value & Format(Now(), "hhmmssddmmyyyy") & Int((999 - 100 + 1) * Rnd + 100) & "','" & Actrlsub.Name & "' ,'" & Actrlsub.OldValue & "', '" & Actrlsub.Value & "', '" & Format(Now(), "dd/mm/yyyy") & "', '" & "by " & UserIdsub & "', '" & Screen.ActiveControl.Parent.Form.Name & "')"
DoCmd.SetWarnings False
ElseIf IsNull(Actrlsub.OldValue) And Len(Actrlsub.Value) > 0 Or Actrlsub.OldValue = "" And Len(Actrlsub.Value) > 0 Then
CurrentDb.Execute "INSERT INTO canregnotes(msbenhnhan, tenbien, myoldval, mynewval, chngdate, madeby, onfrmName) VALUES ('" & Screen.ActiveControl.Parent.Form.Controls("identry").Value & Screen.ActiveControl.Parent.Form.Controls("dtpmkey").Value & Format(Now(), "hhmmssddmmyyyy") & Int((999 - 100 + 1) * Rnd + 100) & "','" & Actrlsub.Name & "' ,'" & "Null" & "', '" & Actrlsub.Value & "', '" & Format(Now(), "dd/mm/yyyy") & "', '" & "by " & UserIdsub & "', '" & Screen.ActiveControl.Parent.Form.Name & "')"
DoCmd.SetWarnings False
ElseIf IsNull(Actrlsub.Value) And Len(Actrlsub.OldValue) > 0 Or Actrlsub.Value = "" And Len(Actrlsub.OldValue) > 0 Then
CurrentDb.Execute "INSERT INTO canregnotes(msbenhnhan, tenbien, myoldval, mynewval, chngdate, madeby, onfrmName) VALUES ('" & Screen.ActiveControl.Parent.Form.Controls("identry").Value & Screen.ActiveControl.Parent.Form.Controls("dtpmkey").Value & Format(Now(), "hhmmssddmmyyyy") & Int((999 - 100 + 1) * Rnd + 100) & "','" & Actrlsub.Name & "' ,'" & Actrlsub.OldValue & "', '" & "Null" & "', '" & Format(Now(), "dd/mm/yyyy") & "', '" & "by " & UserIdsub & "', '" & Screen.ActiveControl.Parent.Form.Name & "')"
DoCmd.SetWarnings False
End If
End Select
TryNextControl:
Next Actrlsub
Exit_SubDTrackChanges:
Exit Sub
End Sub
Step 2. Call the Sub on Before Update
Code:
Private Sub Form_BeforeUpdate(Cancel As Integer)
'On Error GoTo Form_BeforeUpdate_Err
Call SubDTrackChanges
'Form_BeforeUpdate_Exit:
' Exit Sub
'Form_BeforeUpdate_Err:
' MsgBox Err.Number & " - " & Err.Description
' Resume Form_BeforeUpdate_Exit
End Sub
Save, Close and Reopen Form again, enjoy!.
Tuan.