StuLux
Well-known Member
- Joined
- Sep 14, 2005
- Messages
- 682
- Office Version
- 365
- Platform
- Windows
I am using code obtained form this forum to maintain an audit when values are changed using controls on a form. The code is basically this:
Function Audit()
Dim strSQL As String
Dim myForm As Form
Dim ctl As Control
Dim ctlName As String
Set myForm = Screen.ActiveForm
For Each ctl In myForm.Controls
Select Case ctl.ControlType
Case acTextBox, acComboBox, acListBox
'Some controls can't be audited (calculated controls?) so name has
'been changed to begin with SKIPAUDIT for these controls to prevent error
ctlName = ctl.Name
If Mid(ctlName, 1, 9) = "SKIPAUDIT" Then GoTo nextctl:
' If the control was null and is still null skip to next ctl
If IsNull(ctl.Value) And IsNull(ctl.OldValue) Then GoTo nextctl:
' If the value isn't changed OR there isn't a name, skip it all otherwise build SQL statement (strSQL)
If Len(ctl.Name) > 0 And ctl.Value <> ctl.OldValue Or IsNull(ctl.OldValue) Or IsNull(ctl.Value) Then
strSQL = "INSERT INTO tblAudit ([User], [Date], [Project], [ChangedField], [OldData], [NewData])"
strSQL = strSQL & "SELECT "
strSQL = strSQL & "'" & Environ("username") & "', "
strSQL = strSQL & "'" & Format(Date, "dd/mm/yyyy") & "', "
strSQL = strSQL & "'" & myForm!ID_MAIN & "', "
strSQL = strSQL & "'" & ctl.Name & "', "
'If old value is blank then add word "Blank" to OldData field otherwise use OldValue
If IsNull(ctl.OldValue) Or Len(ctl.OldValue) = 0 Then
strSQL = strSQL & "'Blank', "
Else
'following line allows users to type ' or " without error
strSQL = strSQL & "'" & Replace(Replace(ctl.OldValue, Chr(34), ""), "'", "") & "', "
End If
'If value is blank then add word "Blank" to NewData field otherwise use Value
If IsNull(ctl.Value) Or Len(ctl.Value) = 0 Then
strSQL = strSQL & "'Blank'"
'following line allows users to type ' or " without error
Else: strSQL = strSQL & "'" & Replace(Replace(ctl.Value, Chr(34), ""), "'", "") & "' "
End If
'Turn warnings off (to eliminate the Append row warning)
DoCmd.SetWarnings False
DoCmd.RunSQL strSQL
DoCmd.SetWarnings True
End If
End Select
nextctl:
Next ctl
trynextctl:
Exit Function
End Function
This works fine whenever a value changes on the main form but the form also has a sub-form and I cannot work out how I can get this audit routine to pick up changed values on the sub-form also - can anybody help.
P.S. I like the new look forum but I can't see any tags for marking code to stand out from ordinary text, is this no longer possible?
Function Audit()
Dim strSQL As String
Dim myForm As Form
Dim ctl As Control
Dim ctlName As String
Set myForm = Screen.ActiveForm
For Each ctl In myForm.Controls
Select Case ctl.ControlType
Case acTextBox, acComboBox, acListBox
'Some controls can't be audited (calculated controls?) so name has
'been changed to begin with SKIPAUDIT for these controls to prevent error
ctlName = ctl.Name
If Mid(ctlName, 1, 9) = "SKIPAUDIT" Then GoTo nextctl:
' If the control was null and is still null skip to next ctl
If IsNull(ctl.Value) And IsNull(ctl.OldValue) Then GoTo nextctl:
' If the value isn't changed OR there isn't a name, skip it all otherwise build SQL statement (strSQL)
If Len(ctl.Name) > 0 And ctl.Value <> ctl.OldValue Or IsNull(ctl.OldValue) Or IsNull(ctl.Value) Then
strSQL = "INSERT INTO tblAudit ([User], [Date], [Project], [ChangedField], [OldData], [NewData])"
strSQL = strSQL & "SELECT "
strSQL = strSQL & "'" & Environ("username") & "', "
strSQL = strSQL & "'" & Format(Date, "dd/mm/yyyy") & "', "
strSQL = strSQL & "'" & myForm!ID_MAIN & "', "
strSQL = strSQL & "'" & ctl.Name & "', "
'If old value is blank then add word "Blank" to OldData field otherwise use OldValue
If IsNull(ctl.OldValue) Or Len(ctl.OldValue) = 0 Then
strSQL = strSQL & "'Blank', "
Else
'following line allows users to type ' or " without error
strSQL = strSQL & "'" & Replace(Replace(ctl.OldValue, Chr(34), ""), "'", "") & "', "
End If
'If value is blank then add word "Blank" to NewData field otherwise use Value
If IsNull(ctl.Value) Or Len(ctl.Value) = 0 Then
strSQL = strSQL & "'Blank'"
'following line allows users to type ' or " without error
Else: strSQL = strSQL & "'" & Replace(Replace(ctl.Value, Chr(34), ""), "'", "") & "' "
End If
'Turn warnings off (to eliminate the Append row warning)
DoCmd.SetWarnings False
DoCmd.RunSQL strSQL
DoCmd.SetWarnings True
End If
End Select
nextctl:
Next ctl
trynextctl:
Exit Function
End Function
This works fine whenever a value changes on the main form but the form also has a sub-form and I cannot work out how I can get this audit routine to pick up changed values on the sub-form also - can anybody help.
P.S. I like the new look forum but I can't see any tags for marking code to stand out from ordinary text, is this no longer possible?