Hi, absolutely would love to see your example, I completely agree with having one sub routine compared to two.
Less to worry about
Thank you
accote
Hi, absolutely would love to see your example, I completely agree with having one sub routine compared to two.
Less to worry about
Thank you
accote
I changed the If() to SELECT Case statements.
If you have troubles, post the AuditTrail1 code and I'll merge it.Code:Const cDQ As String = """" Sub AuditTrail(frm As Form, RecordID As Control) 'Track changes to data. 'recordid identifies the pk field's corresponding 'control in frm, in order to id record. Dim ctl As Control Dim varBefore As Variant Dim varAfter As Variant Dim strControlName As String Dim strSQL As String On Error GoTo ErrHandler 'Get changed values. For Each ctl In frm.Controls With ctl 'Avoid labels and other controls with out the Value property. Select Case .ControlType 'this replaces>> If .ControlType = acTextBox Then Case acComboBox If (.Value <> .OldValue) Or ((Not IsNull(.OldValue) And IsNull(.Value))) Or ((IsNull(.OldValue) And Not IsNull(.Value))) Then varBefore = .OldValue varAfter = .Value strControlName = .Name If strControlName = "Company" Then varBefore = DLookup("Company", "Institutions", "InstitutionID=" & .OldValue) varAfter = DLookup("Company", "Institutions", "InstitutionID=" & .Value) End If 'Build INSERT INTO statement. strSQL = "INSERT INTO " _ & "Audit (EditDate, User, RecordID, SourceTable, " _ & " SourceField, BeforeValue, AfterValue) " _ & "VALUES (Now()," _ & cDQ & Environ("username") & cDQ & ", " _ & cDQ & RecordID.Value & cDQ & ", " _ & cDQ & frm.RecordSource & cDQ & ", " _ & cDQ & .Name & cDQ & ", " _ & cDQ & varBefore & cDQ & ", " _ & cDQ & varAfter & cDQ & ")" End If Case acTextBox 'put your text box code here 'only the code between ' If .ControlType = acTextBox Then 'End If ' do not include the 'DoCmd.RunSQL lines End Select 'View evaluated statement in Immediate window. Debug.Print strSQL 'execute the SQL DoCmd.SetWarnings False DoCmd.RunSQL strSQL DoCmd.SetWarnings True End With Next Set ctl = Nothing Exit Sub ErrHandler: MsgBox Err.Description & vbNewLine _ & Err.Number, vbOKOnly, "Error" End Sub
One other thing... instead of
I prefer to useCode:DoCmd.SetWarnings False DoCmd.RunSQL strSQL DoCmd.SetWarnings True
It is shorter (1 line vs 3 lines), faster (works directly with Jet) and don't have to worry about setting warnings back on if the code aborts for some reason. Just something (else) to think about.Code:CurrentDB.Execute strSQL, dbFailOnError![]()
Thanks, I tried it but it seems I'm doing something wrong somewhere.
Here is the Code for the other AuditTrail for Text Boxes, it is basically exactly the same except for the name (AuditTrail)
and the ControlType (acTextBox), and of course without the add-on to convert a numbered look-up field.
Thank you very much for your help.
Code:Option Compare Database Const cDQ As String = """" Sub AuditTrail1(frm As Form, RecordID As Control) 'Track changes to data. 'recordid identifies the pk field's corresponding 'control in frm, in order to id record. Dim ctl As Control Dim varBefore As Variant Dim varAfter As Variant Dim strControlName As String Dim strSQL As String On Error GoTo ErrHandler 'Get changed values. For Each ctl In frm.Controls With ctl 'Avoid labels and other controls with Value property. If .ControlType = acTextBox Then If (.Value <> .OldValue) Or ((Not IsNull(.OldValue) And IsNull(.Value))) Or ((IsNull(.OldValue) And Not IsNull(.Value))) Then varBefore = .OldValue varAfter = .Value strControlName = .Name 'Build INSERT INTO statement. strSQL = "INSERT INTO " _ & "Audit (EditDate, User, RecordID, SourceTable, " _ & " SourceField, BeforeValue, AfterValue) " _ & "VALUES (Now()," _ & cDQ & Environ("username") & cDQ & ", " _ & cDQ & RecordID.Value & cDQ & ", " _ & cDQ & frm.RecordSource & cDQ & ", " _ & cDQ & .Name & cDQ & ", " _ & cDQ & varBefore & cDQ & ", " _ & cDQ & varAfter & cDQ & ")" 'View evaluated statement in Immediate window. Debug.Print strSQL DoCmd.SetWarnings False DoCmd.RunSQL strSQL DoCmd.SetWarnings True End If End If End With Next Set ctl = Nothing Exit Sub ErrHandler: MsgBox Err.Description & vbNewLine _ & Err.Number, vbOKOnly, "Error" End Sub
Frankly, I think you were making this more complicated than needed to be. One way to merge code:Also the test (.Value <> .OldValue) is not reliable because can't test if something = Null and if either is Null the expression fails. Review http://allenbrowne.com/casu-12.htmlCode:Sub AuditTrail(frm As Form, RecordID As CONTROL) 'Track changes to data. 'recordid identifies the pk field's corresponding 'control in frm, in order to id record. Dim ctl As CONTROL Dim varBefore As Variant Dim varAfter As Variant Dim strControlName As String Dim strSQL As String On Error GoTo ErrHandler 'Get changed values. For Each ctl In frm.Controls With ctl strControlName = .Name 'Avoid labels and other controls without the Value property If (.ControlType = acComboBox Or .ControlType = acTextBox) And .Value & "" <> .OldValue & "" Then varBefore = .OldValue varAfter = .Value If strControlName = "Company" Then varBefore = DLookup("Company", "Institutions", "InstitutionID=" & .OldValue) varAfter = DLookup("Company", "Institutions", "InstitutionID=" & .Value) End If 'Build INSERT INTO statement. strSQL = "INSERT INTO " _ & "Audit (EditDate, User, RecordID, SourceTable, " _ & "SourceField, BeforeValue, AfterValue) " _ & "VALUES (Now()," _ & cDQ & Environ("username") & cDQ & ", " _ & cDQ & RecordID.Value & cDQ & ", " _ & cDQ & frm.RecordSource & cDQ & ", " _ & cDQ & strControlName & cDQ & ", " _ & cDQ & varBefore & cDQ & ", " _ & cDQ & varAfter & cDQ & ")" 'View evaluated statement in Immediate window. Debug.Print strSQL 'execute the SQL CurrentDb.Execute strSQL, dbFailOnError End If End With Next Set ctl = Nothing Exit Sub ErrHandler: MsgBox Err.Description & vbNewLine _ & Err.Number, vbOKOnly, "Error" End Sub
Do this test in the VBA Immediate window:
?Null = Null
One way to handle possible Null is to concatenate an empty string as shown in my example code.
This code will save audit record for the first data input into control and also if the change is to delete value. I think the SQL will fail because of the apostrophe delimiters when trying to save Null.
Last edited by June7; 11-29-2012 at 11:31 PM.
How to attach file: http://www.accessforums.net/showthread.php?t=70301 To provide db: copy, remove confidential data, run compact & repair, zip w/Windows Compression.
OK, try this. I left the name "AuditTrail". Be sure and try on a copy of the dB.
The "Option Explicit" ensures that you don't mistype variable names. It has saved me many, many times. There is a setting that you can set that will add it automagically to any NEW code page.Code:Option Compare Database 'you should always have these two lines at the top of every code page Option Explicit Const cDQ As String = """" Sub AuditTrail(frm As Form, RecordID As Control) 'Track changes to data. 'recordid identifies the pk field's corresponding 'control in frm, in order to id record. 'currently saves cahnges to 'text boxes and combo boxes Dim ctl As Control Dim varBefore As Variant Dim varAfter As Variant Dim strControlName As String Dim strSQL As String On Error GoTo ErrHandler 'Get changed values. For Each ctl In frm.Controls With ctl 'Avoid labels and other controls with Value property. Select Case .ControlType Case acComboBox, acTextBox If (.Value <> .OldValue) Or ((Not IsNull(.OldValue) And IsNull(.Value))) Or ((IsNull(.OldValue) And Not IsNull(.Value))) Then varBefore = .OldValue varAfter = .Value strControlName = .Name 'if the name is "Company" and the type is combo box 'get the name from the ID If strControlName = "Company" And .ControlType = acComboBox Then varBefore = DLookup("Company", "Institutions", "InstitutionID=" & .OldValue) varAfter = DLookup("Company", "Institutions", "InstitutionID=" & .Value) End If 'Build INSERT INTO statement. strSQL = "INSERT INTO " _ & "Audit (EditDate, User, RecordID, SourceTable, " _ & " SourceField, BeforeValue, AfterValue) " _ & "VALUES (Now()," _ & cDQ & Environ("username") & cDQ & ", " _ & cDQ & RecordID.Value & cDQ & ", " _ & cDQ & frm.RecordSource & cDQ & ", " _ & cDQ & .Name & cDQ & ", " _ & cDQ & varBefore & cDQ & ", " _ & cDQ & varAfter & cDQ & ")" 'View evaluated statement in Immediate window. Debug.Print strSQL 'execute the SQL DoCmd.SetWarnings False DoCmd.RunSQL strSQL DoCmd.SetWarnings True End If End Select End With Next Set ctl = Nothing Exit Sub ErrHandler: MsgBox Err.Description & vbNewLine _ & Err.Number, vbOKOnly, "Error" End Sub
Hi Steve, thanks I will try when I get back from my other job this evening.
Will let you know how it went.
accote, in case you missed them, please consider the notes at bottom of my last post. Are any of these fields allowed to be null or are all required to have data?
How to attach file: http://www.accessforums.net/showthread.php?t=70301 To provide db: copy, remove confidential data, run compact & repair, zip w/Windows Compression.
Hello Steve
I tried it and it works great when editing a record, but when adding a new record it gives me the following error:
It does not add the Company Name or the InstitutionID to the Audit Table when creating a new record,Syntax error (missing operator) in query expression 'InstitutionID='.
3075
everything else entered to the new record shows up fine.
When I go back to edit the same record everything works fine again and if I change the company it
shows up fine also in the audit table like it should.
Sadly I forgot to test it yesterday on a new record with the 2 separate AuditTrail modules, as I get the
same error there, so has nothing to do with merging the two.
And yes, I do have fields that except Null values.
Any idea why it is doing this? If not is there a way to disable that error message as everything is just
fine otherwise, and the Audit table is mainly there for history and changes?
Thanks
accote
My comments in post 19 suggest cause of this error.
How to attach file: http://www.accessforums.net/showthread.php?t=70301 To provide db: copy, remove confidential data, run compact & repair, zip w/Windows Compression.
Hi June
Is there a fix for it, as I can't figure it out. I tried your code on post 19 and that gives me the:
Object doesn't support this property or method (Error 438)
Thanks
accote
What line causes the error? Step debug, comment out 'On error ... (Error handlers are a nuisance during development).
You can use steve's version with the Select Case structure but the issue with Null still needs to be handled. Remember can't test for something = Null so if either .Value or .OldValue is Null the code fails.
If strControlName = "Company" And .ControlType = acComboBox Then
If Not IsNull(varBefore) Then varBefore = DLookup("Company", "Institutions", "InstitutionID=" & .OldValue)
If Not IsNull(varAfter) Then varAfter = DLookup("Company", "Institutions", "InstitutionID=" & .Value)
End If
& IIf(IsNull(varBefore), Null, cDQ & varBefore & cDQ) & ", " _
& IIf(IsNull(varAfter), Null, cDQ & varAfter & cDQ) & ")"
How to attach file: http://www.accessforums.net/showthread.php?t=70301 To provide db: copy, remove confidential data, run compact & repair, zip w/Windows Compression.
Hi accote,
I took what June said and changed the code again. Instead of having a empty field, I used the NZ() function to store "New Record" as the old value. I think storing "New Record" is better than having a NULL or empty string in the field. Of course you can change "New Record" to what ever you want.
Code:Sub AuditTrail(frm As Form, RecordID As Control) 'Track changes to data. 'recordid identifies the pk field's corresponding 'control in frm, in order to id record. 'currently saves cahnges to 'text boxes and combo boxes Dim ctl As Control Dim varBefore As Variant Dim varAfter As Variant Dim strControlName As String Dim strSQL As String On Error GoTo ErrHandler 'Get changed values. For Each ctl In frm.Controls With ctl 'Avoid labels and other controls with Value property. Select Case .ControlType Case acComboBox, acTextBox ' handle NULLs varAfter = Nz(.Value, "New Record") varBefore = Nz(.OldValue, "New Record") If varAfter <> varBefore Then strControlName = .Name 'if the name is "Company" and the type is combo box 'get the name from the ID If strControlName = "Company" And .ControlType = acComboBox Then 'check for record ID If IsNumeric(varBefore) Then varBefore = DLookup("Company", "Institutions", "InstitutionID=" & varBefore) End If If IsNumeric(varAfter) Then varAfter = DLookup("Company", "Institutions", "InstitutionID=" & varAfter) End If End If 'Build INSERT INTO statement. strSQL = "INSERT INTO " _ & "Audit (EditDate, User, RecordID, SourceTable, " _ & " SourceField, BeforeValue, AfterValue) " _ & "VALUES (Now()," _ & cDQ & Environ("username") & cDQ & ", " _ & cDQ & RecordID.Value & cDQ & ", " _ & cDQ & frm.RecordSource & cDQ & ", " _ & cDQ & .Name & cDQ & ", " _ & cDQ & varBefore & cDQ & ", " _ & cDQ & varAfter & cDQ & ")" 'View evaluated statement in Immediate window. Debug.Print strSQL 'execute the SQL DoCmd.SetWarnings False DoCmd.RunSQL strSQL DoCmd.SetWarnings True End If End Select End With Next Set ctl = Nothing Exit Sub ErrHandler: MsgBox Err.Description & vbNewLine _ & Err.Number, vbOKOnly, "Error" End Sub
Thank you both, will try both this evening. I had the a null problem with the original
code and it took me quite some time to figure out to add the red part to make it working.
If (.Value <> .OldValue) Or ((Not IsNull(.OldValue) And IsNull(.Value))) Or ((IsNull(.OldValue) And Not IsNull(.Value))) Then
Again, thanks to both of you I'll let you know how it goes
Remember, the expression (.Value <> .OldValue) will fail if either is Null. The result is neither True nor False, it is Null. I like Steve's modification for handling Null.
Last edited by June7; 12-01-2012 at 11:48 PM.
How to attach file: http://www.accessforums.net/showthread.php?t=70301 To provide db: copy, remove confidential data, run compact & repair, zip w/Windows Compression.
Steve your code is working 100%,I tested it in every way possible, wonderful thank you so much.
Instead of "New Record" I'm using "No Entry" since it show on edit's also, so no confusion. My Form
that brings up the Audit table info, can be nicely sorted now.
I found a nice one day class on VBA coding, will take it and hopefully that will help me understand it
a bit more, since that is where I always get stuck.
I'm very persistent when trying to figure something out (my way of learning) that sometimes I spend
days on a problem, most of the times I'll figure it out eventually but then there is the occasion like this
when I'm grateful there are people like you guys willing to help.
Steve & June, thank you both for all your help.
accote