I'm working on another function, which a continued discussion regarding Martin Greene's audit trail code and problems users are having with the original code and how it does NOT working when subform exist. My code only deals with one field name "TraceabilityCode", for now. Basing the design on the original code, I've modified it to only deal with one subform and it's controls. I'm trying to compare whether a new value has been entered and compare it to the oldvalue. And even using my edit form and changing the value of this traceability code, the program below does NOT compare the two values and spark off an entry into the audit table.
Sub Subform_Controls(MEMBER_ID As String, UserAction As String)
'On Error GoTo AuditChanges_Err
Dim cnn As ADODB.Connection
Dim rstAudit As ADODB.Recordset
Dim ctl As Control
Dim datTimeCheck As Date
Dim strUserID As String
Dim MaxMember_id As Integer
Dim frmCurrentForm As SubForm
Dim subcontrolTraceCodeNew As String
Dim subcontrolTraceCodeOldvalue As String
Set cnn = CurrentProject.Connection
Set rstAudit = New ADODB.Recordset
rstAudit.Open "Select * from Audit_Trail", cnn, adOpenDynamic, adLockOptimistic
datTimeCheck = Now()
strUserID = CurrentUser()
MaxMember_id = DMax("[MEMBER_ID]", "BUSINESS")
Set frmCurrentForm = Forms!frm_EDIT_CURRENT_FULLGROWER!GROWER_TRACEABIL ITY_DATASHEET
Select Case UserAction
'existing records
Case "Edit"
For Each ctl In Forms("frm_EDIT_CURRENT_FULLGROWER").Controls("GRO WER_TRACEABILITY_DATASHEET").Form.Controls
subcontrolTraceCodeNew = Forms("frm_EDIT_CURRENT_FULLGROWER").Controls("GRO WER_TRACEABILITY_DATASHEET").Form.Controls("Tracea bilityCode").Value
subcontrolTraceCodeOldvalue = Forms("frm_EDIT_CURRENT_FULLGROWER").Controls("GRO WER_TRACEABILITY_DATASHEET").Form.Controls("Tracea bilityCode").OldValue
If ctl.Tag = "Audit" Then
'If ctl.ControlType = acLabel Or ctl.ControlType = acComboBox Or ctl.ControlType = acCheckBox Then
Debug.Print "Control Name = " & ctl.Name & vbNewLine & "Control Type = " & ctl.ControlType; vbNewLine & "Control Value = " & ctl.OldValue
If subcontrolTraceCodeNew <> subcontrolTraceCodeOldvalue Then..... this line is not successful in making the comparisons, therefore, none of the new values are entered into the audit table.
With rstAudit
.AddNew
![DateTime] = datTimeCheck
![UserName] = strUserID
![FormName] = Screen.ActiveForm.Name
![Action] = UserAction
![Record_ID] = MaxMember_id
![FieldName] = ctl.ControlSource
![OldValue] = ctl.OldValue
![NewValue] = ctl.Value
.Update
'Debug.Print "Current values " & UserAction
End With
Else: subcontrolTraceCodeNew = subcontrolTraceCodeOldvalue
Debug.Print "Values are the same"
End If
'End If
'nd If
End If
Next ctl
Case Else
' New or deleted records
For Each ctl In Forms("frm_EDIT_CURRENT_FULLGROWER").Controls("GRO WER_TRACEABILITY_DATASHEET").Form.Controls
subcontrolTraceCodeNew = Forms("frm_EDIT_CURRENT_FULLGROWER").Controls("GRO WER_TRACEABILITY_DATASHEET").Form.Controls("Tracea bilityCode").Value
subcontrolTraceCodeOldvalue = Forms("frm_EDIT_CURRENT_FULLGROWER").Controls("GRO WER_TRACEABILITY_DATASHEET").Form.Controls("Tracea bilityCode").OldValue
If ctl.Tag = "Audit" Then
'If ctl.ControlType = acLabel Or ctl.ControlType = acComboBox Or ctl.ControlType = acCheckBox Then
Debug.Print "Control Name = " & ctl.Name & vbNewLine & "Control Type = " & ctl.ControlType; vbNewLine & "Control Value = " & ctl.OldValue
If subcontrolTraceCodeNew <> subcontrolTraceCodeOldvalue Then
With rstAudit
.AddNew
![DateTime] = datTimeCheck
![UserName] = strUserID
![FormName] = Screen.ActiveForm.Name
![Action] = UserAction
![Record_ID] = MaxMember_id
![FieldName] = ctl.ControlSource
' ![OldValue] = ctl.OldValue
![NewValue] = ctl.Value
.Update
End With
End If
' End If
End If
Next ctl
End Select
AuditChanges_exit:
On Error Resume Next
rstAudit.Close
cnn.Close
Set rstAudit = Nothing
Set cnn = Nothing
Exit Sub
AuditChanges_Err:
MsgBox Err.Description, vbCritical, "Error!"
Resume AuditChanges_exit
End Sub