H
Havanablue
Guest
In my database, I use a form for inputting and viewing information that consists of a main form that contains personal client information such as name, address, telephone number, etc. This form then has two subforms attached to it that track different types of monetary donations. It was decided that an audit trail needed to be created in the main form to keep track of changes made to the data. Thanks to this message board (and I am sorry to say I cannot remember which member posted it, but many thanks, to whoever did) I was able to find the following code, which has worked great:
Public Function Audit_Trail()
On Error GoTo Err_Audit_Trail
Dim MyForm As Form
Dim ctl As Control
Dim sUser As String
Set MyForm = Screen.ActiveForm
' sUser = "User: " & UsersID 'You need to identify your users if you are not using Access security with workgroups.
sUser = CurrentUser
'If new record, record it in audit trail and exit function.
If MyForm.NewRecord = True Then
MyForm!Updates = MyForm!Updates & "New Record added on " & Now & " by " & sUser & ";"
Exit Function
End If
'Set date and current user if the form (current record) has been modified.
MyForm!Updates = MyForm!Updates & vbCrLf & vbLf & "Changes made on " & Now & " by " & sUser & ";"
MyForm!Last_Updated = MyForm!Last_Updated & Date
'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 = "tbAuditTrail" Then GoTo TryNextControl 'Skip AuditTrail field.
'If new and old value do not equal
If ctl.Value <> ctl.OldValue Then
MyForm!Updates = MyForm!Updates & vbCrLf & ctl.Name & ": Changed From: " & ctl.OldValue & ", To: " & ctl.Value
'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
MyForm!Updates = MyForm!Updates & vbCrLf & ctl.Name & ": Was Previoulsy Null, New Value: " & ctl.Value
'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
MyForm!Updates = MyForm!Updates & vbCrLf & ctl.Name & ": Changed From: " & ctl.OldValue & ", To: Null"
End If
End Select
TryNextControl:
Next ctl
Exit_Audit_Trail:
Exit Function
Err_Audit_Trail:
If Err.Number = 64535 Then 'Operation is not supported for this type of object.
Exit Function
ElseIf Err.Number = 2475 Then 'You entered an expression that requires a form to be the active window
Beep
MsgBox "A form is required to be the active window!", vbCritical, "Invalid Active Window"
Else
Beep
MsgBox Err.Number & " - " & Err.Description
End If
Resume Exit_Audit_Trail
End Function
Now The Powers That Be have decided that we need to add something similar, but much simpler to the subforms. Basically, TPTB want only the date the last change was made to a record to appear in a date field. In an attempted to do this we took the above code and modified it ourselves (always a bad idea) to the following:
Public Function Mem_Hist()
Dim MyForm As Form
Dim ctl As Control
Set MyForm = Screen.ActiveForm
Dim Membership_Information As SubForm
'Set date if the form (current record) has been modified.
MyForm.[Membership_Information]!Date_Stamp = MyForm.[Membership_Information]!Date_Stamp & Date
'Check each data entry control for change
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 = "tbAuditTrail" Then GoTo TryNextControl 'Skip AuditTrail field.
'If new and old value do not equal
If ctl.Value <> ctl.OldValue Then
MyForm.[Membership_Information]!Date_Stamp = MyForm.[Membership_Information]!Date_Stamp & Date
'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
MyForm.[Membership_Information]!Date_Stamp = MyForm.[Membership_Information]!Date_Stamp & Date
'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
MyForm.[Membership_Information]!Date_Stamp = MyForm.[Membership_Information]!Date_Stamp & Date
End If
End Select
TryNextControl:
Next ctl
Exit_Mem_Hist:
Exit Function
Err_Mem_Hist:
If Err.Number = 64535 Then 'Operation is not supported for this type of object.
Exit Function
ElseIf Err.Number = 2475 Then 'You entered an expression that requires a form to be the active window
Beep
MsgBox "A form is required to be the active window!", vbCritical, "Invalid Active Window"
Else
Beep
MsgBox Err.Number & " - " & Err.Description
End If
Resume Exit_Mem_Hist
End Function
Now this works, sort of. When someone changes a record, it does put the current date in the correct field, but once the record has been updated no one cannot go back in and make any other changes. For example, if you enter $20.00 as a donation and the donation was actually $120.00 after you have exited that record and the date field has been updated the only way to make any additional changes is to close the form and open the table that the subform was created from.
We can make a hundred changes a day to the same record in the main form with no problems. How do we get that nirvana with the subforms?
Sorry about the long post, but any information that can be provided will be helpful.
Thanks so much.
Public Function Audit_Trail()
On Error GoTo Err_Audit_Trail
Dim MyForm As Form
Dim ctl As Control
Dim sUser As String
Set MyForm = Screen.ActiveForm
' sUser = "User: " & UsersID 'You need to identify your users if you are not using Access security with workgroups.
sUser = CurrentUser
'If new record, record it in audit trail and exit function.
If MyForm.NewRecord = True Then
MyForm!Updates = MyForm!Updates & "New Record added on " & Now & " by " & sUser & ";"
Exit Function
End If
'Set date and current user if the form (current record) has been modified.
MyForm!Updates = MyForm!Updates & vbCrLf & vbLf & "Changes made on " & Now & " by " & sUser & ";"
MyForm!Last_Updated = MyForm!Last_Updated & Date
'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 = "tbAuditTrail" Then GoTo TryNextControl 'Skip AuditTrail field.
'If new and old value do not equal
If ctl.Value <> ctl.OldValue Then
MyForm!Updates = MyForm!Updates & vbCrLf & ctl.Name & ": Changed From: " & ctl.OldValue & ", To: " & ctl.Value
'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
MyForm!Updates = MyForm!Updates & vbCrLf & ctl.Name & ": Was Previoulsy Null, New Value: " & ctl.Value
'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
MyForm!Updates = MyForm!Updates & vbCrLf & ctl.Name & ": Changed From: " & ctl.OldValue & ", To: Null"
End If
End Select
TryNextControl:
Next ctl
Exit_Audit_Trail:
Exit Function
Err_Audit_Trail:
If Err.Number = 64535 Then 'Operation is not supported for this type of object.
Exit Function
ElseIf Err.Number = 2475 Then 'You entered an expression that requires a form to be the active window
Beep
MsgBox "A form is required to be the active window!", vbCritical, "Invalid Active Window"
Else
Beep
MsgBox Err.Number & " - " & Err.Description
End If
Resume Exit_Audit_Trail
End Function
Now The Powers That Be have decided that we need to add something similar, but much simpler to the subforms. Basically, TPTB want only the date the last change was made to a record to appear in a date field. In an attempted to do this we took the above code and modified it ourselves (always a bad idea) to the following:
Public Function Mem_Hist()
Dim MyForm As Form
Dim ctl As Control
Set MyForm = Screen.ActiveForm
Dim Membership_Information As SubForm
'Set date if the form (current record) has been modified.
MyForm.[Membership_Information]!Date_Stamp = MyForm.[Membership_Information]!Date_Stamp & Date
'Check each data entry control for change
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 = "tbAuditTrail" Then GoTo TryNextControl 'Skip AuditTrail field.
'If new and old value do not equal
If ctl.Value <> ctl.OldValue Then
MyForm.[Membership_Information]!Date_Stamp = MyForm.[Membership_Information]!Date_Stamp & Date
'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
MyForm.[Membership_Information]!Date_Stamp = MyForm.[Membership_Information]!Date_Stamp & Date
'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
MyForm.[Membership_Information]!Date_Stamp = MyForm.[Membership_Information]!Date_Stamp & Date
End If
End Select
TryNextControl:
Next ctl
Exit_Mem_Hist:
Exit Function
Err_Mem_Hist:
If Err.Number = 64535 Then 'Operation is not supported for this type of object.
Exit Function
ElseIf Err.Number = 2475 Then 'You entered an expression that requires a form to be the active window
Beep
MsgBox "A form is required to be the active window!", vbCritical, "Invalid Active Window"
Else
Beep
MsgBox Err.Number & " - " & Err.Description
End If
Resume Exit_Mem_Hist
End Function
Now this works, sort of. When someone changes a record, it does put the current date in the correct field, but once the record has been updated no one cannot go back in and make any other changes. For example, if you enter $20.00 as a donation and the donation was actually $120.00 after you have exited that record and the date field has been updated the only way to make any additional changes is to close the form and open the table that the subform was created from.
We can make a hundred changes a day to the same record in the main form with no problems. How do we get that nirvana with the subforms?
Sorry about the long post, but any information that can be provided will be helpful.
Thanks so much.
