Problem with Audit code for Null/Blank records - SOLVED

[StuLux]

I am using the following code (adapted from the Microsoft article on Access Audit trail).

The code writes values to text boxes (txtMeasure, txtOldData, txtNewData) on the form and then the query "qAudit" uses the values from these text boxes to append to an audit table. A record is not created when the existing value is Blank or Null, I have tried many combinations of code to get this to happen but am failing somewhere? My latest attempt is indicated below.

Function Audit()
On Err GoTo Err_Handler

    Dim myForm As Form, ctl As Control
    Set myForm = Screen.ActiveForm
    
'Check each data entry control for change and record old value of Control
    For Each ctl In myForm.Controls
'Only check data entry type controls.
    Select Case ctl.ControlType
        Case acTextBox, acComboBox, acListBox, acOptionGroup, acCheckBox
'Skip fields used to collate changes
        If ctl.Name <> "txtMeasure" Or ctl.Name <> "txtOldData" Or _
        ctl.Name <> "txtNewData" Then
        
        myForm!txtMeasure = ctl.Name 'Applys the name of the ctl to txtMeasure

'If control had previous value, record previous value
            If ctl.Value <> ctl.OldValue Then
                myForm!txtOldData = ctl.OldValue

If IsNull(ctl.OldValue) Or ctl.OldValue = "" Then myForm!txtOldData = "Blank" 'This is the line I am trying to get to work

        myForm!txtNewData = ctl.Value 'Applys new value to txtNewData

'Runs the qAudit append query to create a new record in tblAUDIT
        DoCmd.SetWarnings False
        DoCmd.OpenQuery "qAudit"
        DoCmd.SetWarnings True
            End If
        End If
        End Select
    Next ctl

trynextctl:
    Exit Function

Err_Handler:
    If Err.Number <> 64535 Then
        MsgBox "Error #: " & Err.Number & vbCrLf & "Description: " & Err.Description
    End If
    Resume trynextctl:
End Function

 

[mdmilner]

Perhaps you might try:

If IsNull(ctl.OldValue) Or len(ctl.OldValue) = 0 Then myForm!txtOldData = "Blank"

This just tests the length of the string of the value in the control.

Mike

 

[StuLux]

Thanks Mike but this doesn't work either, I'll carry on trying but if anybody does have any ideas how I can achieve this?

 

[mdmilner]

I have a suspicion your problem is in your SQL statement - you're actually getting an error message that you can't see when you turn off your warnings.

So - how about this.

Do you know how to step through your code and to set breakpoints?

First try this - right on the for each ctl line, do a single left click on the left hand side border. It should drop a "red dot" designating the breakpoint and then sort of red-highlight the entire line. Until you remove this, when this code runs, it will stop at this point.

Second - go to your view menu and either take advantage of your Locals OR Watch OR your immediate window. Locals window displays the current value of each defined variable. Your Watch window can be set to display any calculated value you wish (including control values) AND you can always use something like

?ctl.Value

And the current value of whatever control is currently selected will be displayed. The ? is equivalent to the "Debug.Print" command.

What I'm really telling you are the basic self-debugging tools you need to figure out what's really going on.

From here, run the program - and then watch the window stop on the line with the breakpoint. From here, you can tap the F8 key line by line and watch the flow of the program. My personal guess (without leaning over your shoulder) is that your program runs as expected. I would try stepping into the trouble line and then on the next, use the immediate window to check each of the test values and see if any failed OR if it actually moved into it (the latter is my suspicion)
--
After all that background, I think your append query is attempting to update with null data and failing. The work-around is to substitute something else that it can dump OR (preferable) not dump anything at all.

How? Change your approach. Instead of using DoCmd.OpenQuery - lets go to building a raw SQL statement and then using the DoCmd.RunSQL command.

Dim strSQL As String

strSQL = "INSERT INTO tblAudit (a, b, c) "
strSQL = strSQL & "SELECT "
strSQL = strSQL & "'" & ctl.Name & "', "
strSQL = strSQL & "'" & ctl.OldValue & "', "
strSQL = strSQL & "'" & ctl.Value & "' "
DoCmd.RunSQL strSQL

Here's your basic addition however it has the same flaw as the prior approach (probably). I don't know your field names so I used a & b & c. What you need to do is add a test to look for the empty/null values and then wrap it around the portion of the SQL statement

Now, this is just an adaptation and simplification of your code:

Function Audit()
On Err GoTo Err_Handler

Dim strSQL As String
Dim myForm As Form, ctl As Control

Set myForm = Screen.ActiveForm
    
For Each ctl In myForm.Controls
  Select Case ctl.ControlType
     Case acTextBox, acComboBox, acListBox, acOptionGroup, acCheckBox
        
        ' If the value isn't changed OR there isn't a name, skip it all
        If Len(ctl.Name) > 0 And ctl.Value <> ctl.OldValue Then
          strSQL = "INSERT INTO tblAudit (a, b, c) "
          strSQL = strSQL & "SELECT "
          strSQL = strSQL & "'" & ctl.Name & "', "
          Select Case ctl.Value
            Case Is <> ctl.OldValue
            Case IsNull
               
          If IsNull(ctl.OldValue) Or Len(ctl.OldValue) = 0 Then
            strSQL = strSQL & "'Blank', "
          Else
            strSQL = strSQL & "'" & ctl.OldValue & "', "
          End If
          If Len(ctl.Value) > 0 Then
            strSQL = strSQL & "'" & ctl.Value & "' "
          End If
        End If
        DoCmd.SetWarnings False
        DoCmd.RunSQL strSQL
        DoCmd.SetWarnings True

    End Select
Next ctl

trynextctl:
    Exit Function

Err_Handler:
    Select Case Err.Number
        Case 64535 'some handling here?
        Case Else
            MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical, "modName.FunctionName"
    End Select
    Resume trynextctl:
End Function

Mike

 

[mdmilner]

I should have added one other detail. I completely tossed the idea of using dedicated controls to store the values of each control as you went through them. Frankly, that's entirely too clunky and prone to OTHER problems for my taste - especially when it's completely unnecessary to achieve the same results.

It's roughly equivalent to:

Creating a variable and putting a value in it
Creating another variable and putting the value in the first here
Copy the 2nd variable to a new destination (the append query)

Why not just use the first variable?

Mike

 

[StuLux]

Mike

I really appreciate the time you have spent looking at this, I followed your instructions for debugging and learnt loads more about how to watch VBA routines and look for errors etc.

I like the way you are going here, particulalrly about removing the txt boxes. However I am getting a compile error "Argument not Optional" on the line that says

Case IsNull

I'm sure this is simple but being a VBA newbie I can't suss this out, can you help please?


Experimenting I have almost got the code running but I'm getting an SQL error "Invalid SQL Statement; expected 'DELETE', 'INSERT', 'PROCEDURE', 'SELECT', or 'UPDATE'"

Again I can't understand htis as the SQL statement does appear to begin with INSERT?? I will continue to try and debug.


Stuart

 

[StuLux]

I think I am getting somewhere, my code now looks like this:

Option Explicit

Function Audit()
On Err GoTo Err_Handler

Dim strSQL As String
Dim myForm As Form, ctl As Control

Set myForm = Screen.ActiveForm
    
For Each ctl In myForm.Controls
    Select Case ctl.ControlType
     Case acTextBox, acComboBox
        
' If the value isn't changed OR there isn't a name, skip it all
        If Len(ctl.Name) > 0 And ctl.Value <> ctl.OldValue Then
          strSQL = "INSERT INTO tblAudit ([User], [Date], [Project], [ChangedField], [OldData], [NewData])"
          strSQL = strSQL & "SELECT "
          strSQL = strSQL & "'" & Environ("username") & "', "
          strSQL = strSQL & "'" & Now() & "', "
          strSQL = strSQL & "'" & myForm!ID_MAIN & "', "
          strSQL = strSQL & "'" & ctl.Name & "', "
              Select Case ctl.Value
                Case Is <> ctl.OldValue
                  Case IsNull
              
              If IsNull(ctl.OldValue) Or Len(ctl.OldValue) = 0 Then
                strSQL = strSQL & "'Blank', "
                  Else
                      strSQL = strSQL & "'" & ctl.OldValue & "', "
              End If
              End Select
                  If Len(ctl.Value) > 0 Then
                    strSQL = strSQL & "'" & ctl.Value & "' "
                      Else: strSQL = strSQL & "'Blank', "
              End If
                DoCmd.SetWarnings False
                Debug.Print strSQL
                DoCmd.RunSQL strSQL
                DoCmd.SetWarnings True
          End If

    End Select
Next ctl

trynextctl:
    Exit Function

Err_Handler:
    Select Case Err.Number
        Case 64535 'some handling here?
        Case Else
            MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical, "modName.FunctionName"
    End Select
    Resume trynextctl:
End Function

I can get this to work if I comment out the "Case IsNull" line but it still doesn't create an entry if the previous value was null - I have added code to show "Blank" in the NewData field if the user deletes the entry.

 

[mdmilner]

I looks like you picked out my error on the Select Case segment. I completely failed to add in an End Case. I guess that's what I get for not even trying to run the code myself.

What I'd intended to do was wipe out the select case entirely. Here's a quick revision that I actually tested, briefly. The error message you reported made me think it was generating a bad SQL statement. If you did a ?strSQL you'd probably see the incomplete message. One thing I like to do sometimes is to cut and paste the raw SQL into a query and see if it translates.

Function Audit()
On Err GoTo Err_Handler

Dim strSQL As String
Dim myForm As Form, ctl As Control

Set myForm = Screen.ActiveForm
   
For Each ctl In myForm.Controls
  Select Case ctl.ControlType
     Case acTextBox, acComboBox, acListBox, acOptionGroup, acCheckBox
       
        ' If the value isn't changed OR there isn't a name, skip it all
        If Len(ctl.Name) > 0 And ctl.Value <> ctl.OldValue Then
          strSQL = "INSERT INTO tblAudit (a, b, c) "
          strSQL = strSQL & "SELECT "
          strSQL = strSQL & "'" & ctl.Name & "', "
               
          If IsNull(ctl.OldValue) Or Len(ctl.OldValue) = 0 Then
            strSQL = strSQL & "'Blank', "
          Else
            strSQL = strSQL & "'" & ctl.OldValue & "', "
          End If
          If Len(ctl.Value) > 0 Then
            strSQL = strSQL & "'" & ctl.Value & "' "
          End If
          DoCmd.SetWarnings False
          DoCmd.RunSQL strSQL
          DoCmd.SetWarnings True
        End If
    End Select
Next ctl

trynextctl:
    Exit Function

Err_Handler:
    Select Case Err.Number
        Case 64535 'some handling here?
        Case Else
            MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical, "modName.FunctionName"
    End Select
    Resume trynextctl:
End Function

 

[StuLux]

Thaks for clarifying that one. Thsi code is far better than what I started with but it is still not creating a record when the ctl.OldValue is null.

It creates a record with "blank" in NewData when I delete the contents of a control and it creates a recored when I change an existing value of a control but not when I add a vlaue to a control that was blank.

 

[StuLux]

OK - think I've got it now. I inserted a line that says if both the value and oldvalue are null to skip to next ctl, the code you supplied puts "Blank" if the oldvalue was Null and I've added a line that inserts "Blank" if the (new) value is Null. I have also added a check to the line that checks whether the value has changed to check whether either values are null and to continue with strSQL if either is, seems to work OK, many thanks for your help, I've learnt loads about how to trace errors now!!

Option Explicit

Function Audit()
On Err GoTo Err_Handler

Dim strSQL As String
Dim myForm As Form, ctl As Control

Set myForm = Screen.ActiveForm
    
For Each ctl In myForm.Controls
    Select Case ctl.ControlType
     Case acTextBox, acComboBox
     
Debug.Print ctl.Name, ctl.OldValue, ctl.Value, strSQL
' 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 & "'" & Now() & "', "
          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
                strSQL = strSQL & "'" & ctl.OldValue & "', "
            Debug.Print strSQL
            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'"
                    Else: strSQL = strSQL & "'" & ctl.Value & "' "
                    Debug.Print strSQL
                    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

Err_Handler:
    Select Case Err.Number
        Case 64535 'some handling here?
        Case Else
            MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical, "modName.FunctionName"
    End Select
    Resume trynextctl:
End Function