Go Back   Access World Forums > Microsoft Access Discussion > Modules & VBA

 
Reply
 
Thread Tools Rate Thread Display Modes
Old 09-23-2008, 05:44 PM   #1
RodgerDJr
Registered User
 
Join Date: Aug 2008
Location: Florida
Posts: 33
Thanks: 0
Thanked 0 Times in 0 Posts
RodgerDJr is on a distinguished road
Audit Trail

I am working with this code to do an Audit Trail
What I want is to get the TEXT for a combo box and not the (first) column.

http://articles.techrepublic.com.com...1-6166807.html
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 Value property.
    If .ControlType = acTextBox Then
      If .Value <> .OldValue 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


Last edited by RodgerDJr; 09-24-2008 at 03:03 AM. Reason: Fix Code so it is not on one line
RodgerDJr is offline   Reply With Quote
Old 09-23-2008, 08:00 PM   #2
CyberLynx
Stuck On My Opinions
 
Join Date: Jan 2008
Posts: 585
Thanks: 0
Thanked 4 Times in 4 Posts
CyberLynx will become famous soon enough
Re: Audit Trail

Quote:
What I want is to get the TEXT for a combo box and not the (first) column.
Me.MyComboBoxName.Value

I don't see a reference to a ComboBox within your code

.
__________________
Self taught in all Environments.....and it shows
To view links or images in signatures your post count must be 10 or greater. You currently have 0 posts.
CyberLynx is offline   Reply With Quote
Old 09-24-2008, 03:07 AM   #3
RodgerDJr
Registered User
 
Join Date: Aug 2008
Location: Florida
Posts: 33
Thanks: 0
Thanked 0 Times in 0 Posts
RodgerDJr is on a distinguished road
Re: Audit Trail

I am WANTING to put in ComboBox in the code above I can get value but that would only give me the ID and not the text. I guess I can try .value.Column(1) and .oldValue.Column(1)

RodgerDJr is offline   Reply With Quote
Old 09-24-2008, 04:17 AM   #4
gemma-the-husky
Super Moderator
 
gemma-the-husky's Avatar
 
Join Date: Sep 2006
Location: UK
Posts: 13,372
Thanks: 51
Thanked 932 Times in 902 Posts
gemma-the-husky is a glorious beacon of light gemma-the-husky is a glorious beacon of light gemma-the-husky is a glorious beacon of light gemma-the-husky is a glorious beacon of light gemma-the-husky is a glorious beacon of light gemma-the-husky is a glorious beacon of light
Re: Audit Trail

a combo box is zero base

sosay

dim v as variant 'as an example

v = mycombobox 'actually dereference the first column, column(0)
v= mycombobox.column(0) 'does the same thing
v = mycombobox.column(1) 'deferences the second column

etc

now the columns are as ordered in the underlying query, so that columns with a width of 0 in the list box, are nevertheless included in the column count.

--------
the concept of oldvalue applies to the value of the combo box. The combo box value actually is determined by the bound column (generally first column (ie column(0)), but not necessarily.

so combobox.oldvalue stores the previous value of the combobox BEFORE it is written (ie it is available for inspection in beforeupdate), but this does not mean that the other columns can also be examined directly by referring to the oldvalue.

if you need them, you ought to save them in variables in the current and afterupdate events of the combo box. (easiest, i would think)
gemma-the-husky is offline   Reply With Quote
Old 08-23-2013, 02:08 PM   #5
johngachui
Newly Registered User
 
Join Date: Aug 2013
Posts: 2
Thanks: 0
Thanked 1 Time in 1 Post
johngachui is on a distinguished road
Re: Audit Trail

This is my solution based on the one by Martin Green

I have changed things to
1. Save additions the same way as edits
2. To save old and new values in memo fields as concantenated strings of "[fieldname1]:[value1];.....[fieldname(n)]:[value(n)]"
3. To save ID of deleted record correctly (the original solution seemed to have a problem)
4. Gets combo displayed text instead of bound column (unless they are the same!)
5. Includes reference to fOSMachineName() code from Dev Ashish for computer name

Modified code: (See Green's solution for full explanation)
Sub AuditChanges(IDField As String, UserAction As String, Optional DeletedID As String)
'On Error GoTo AuditChanges_Err

Dim rst As Recordset
Dim ctl As control
Dim datTimeCheck As Date
Dim strUserID As String
Dim prp As Property
Dim updatectl As Boolean
Dim OldStr As String, NewStr As String
Dim colx As Integer, colwidth As String, lenx As Integer, str As String, valx As Integer, visiblecol As Boolean
Dim i As Long, OldID, NewID

Set rst = CurrentDb.OpenRecordset("Audit")

datTimeCheck = Now()
strUserID = fOSMachineName()
Select Case UserAction
Case "DELETE"
With rst
.AddNew
![DateTime] = datTimeCheck
![Username] = strUserID
![FormName] = Screen.ActiveForm.Name
![Action] = UserAction
![RecordID] = DeletedID
.Update
End With
Case Else
OldStr = ""
NewStr = ""
For Each ctl In Screen.ActiveForm.Controls
updatectl = False
For Each prp In ctl.Properties
If prp.Name = "Controlsource" Then
If IsNull(ctl.ControlSource) = False Then updatectl = True
End If
Next prp

If ctl.ControlType = acComboBox Then
colx = 0
visiblecol = False
colwidth = ctl.ColumnWidths
lenx = Len(colwidth)

For i = 1 To lenx
str = Mid(colwidth, i, 1)
If visiblecol = False Then
If IsNumeric(str) = True Then
valx = Val(str)
If valx > 0 Then visiblecol = True
Else
If str = ";" Then colx = colx + 1
End If
End If
Next i

End If

If updatectl = True Then
If Nz(ctl.Value) <> Nz(ctl.OldValue) Then
If OldStr > "" Then
OldStr = OldStr & " ; "
NewStr = NewStr & " ; "
End If
If ctl.ControlType = acComboBox Then
For i = 0 To (ctl.ListCount - 1)
If Trim(ctl.Column(ctl.BoundColumn - 1, i)) = Trim(ctl.OldValue) Then
OldStr = OldStr & ctl.ControlSource & " : " & ctl.Column(colx, i)
End If
Next i

NewStr = NewStr & ctl.ControlSource & " : " & ctl.Column(colx)
Else
OldStr = OldStr & ctl.ControlSource & " : " & ctl.OldValue
NewStr = NewStr & ctl.ControlSource & " : " & ctl.Value
End If
End If
End If
Next ctl
If UserAction = "NEW" Then OldStr = ""
With rst
.AddNew
![DateTime] = datTimeCheck
![Username] = strUserID
![FormName] = Screen.ActiveForm.Name
![Action] = UserAction
![RecordID] = Screen.ActiveForm.Controls(IDField).Value
![OldValue] = OldStr
![NewValue] = NewStr
.Update
End With

End Select
AuditChanges_Exit:
On Error Resume Next
rst.Close
Set rst = Nothing
Exit Sub
AuditChanges_Err:
MsgBox Err.Description, vbCritical, "ERROR!"
Resume AuditChanges_Exit
End Sub

Call from each form with:
assumption is your PK id called ID

Dim DelID As String

Private Sub Form_BeforeUpdate(Cancel As Integer)
If Me.NewRecord Then
Call AuditChanges("ID", "NEW")
Else
Call AuditChanges("ID", "EDIT")
End If
End Sub

Private Sub Form_Delete(Cancel As Integer)
DelID = [ID]
End Sub

Private Sub Form_AfterDelConfirm(Status As Integer)
If Status = acDeleteOK Then Call AuditChanges("ID", "DELETE", DelID)
End Sub
johngachui is offline   Reply With Quote
The Following User Says Thank You to johngachui For This Useful Post:
rd11 (11-28-2013)
Old 08-23-2013, 02:29 PM   #6
pbaldy
Wino Moderator
 
pbaldy's Avatar
 
Join Date: Aug 2003
Location: Nevada, USA
Posts: 30,714
Thanks: 8
Thanked 3,632 Times in 3,575 Posts
pbaldy is a splendid one to behold pbaldy is a splendid one to behold pbaldy is a splendid one to behold pbaldy is a splendid one to behold pbaldy is a splendid one to behold pbaldy is a splendid one to behold pbaldy is a splendid one to behold
Re: Audit Trail

Do you have a question, or just reviving a 5 year-old thread with your solution?
__________________
Paul
Microsoft Access MVP

To view links or images in signatures your post count must be 10 or greater. You currently have 0 posts.
pbaldy is offline   Reply With Quote
Old 08-23-2013, 09:55 PM   #7
johngachui
Newly Registered User
 
Join Date: Aug 2013
Posts: 2
Thanks: 0
Thanked 1 Time in 1 Post
johngachui is on a distinguished road
Re: Audit Trail

No question just think it is a better solution than any other here and problem still exists after 5 years

John

johngachui is offline   Reply With Quote
Old 11-28-2013, 07:37 PM   #8
rd11
Newly Registered User
 
Join Date: Nov 2013
Posts: 1
Thanks: 1
Thanked 0 Times in 0 Posts
rd11 is on a distinguished road
Re: Audit Trail

Got this audit trail working with a minor change as it kicked up errors. The old code of

If UserAction = "NEW" Then OldStr = ""

was changed to

If UserAction = "NEW" Then OldStr = "New Record"

I have not been able to get the code to work on a subform of my main form. I believe that I need to reference the subform using Screen.ActiveForm!SubformControlName.Form, but I am not sure how to implement that in this code to make it work. Any suggestions?

TIA

rd11 is offline   Reply With Quote
Reply

Thread Tools
Display Modes Rate This Thread
Rate This Thread:

Forum Jump

Similar Threads
Thread Thread Starter Forum Replies Last Post
Audit Trail and Find and Replace issue ChrisB37 Modules & VBA 25 07-19-2006 09:37 AM
Audit Trail Chaos ChrisB37 Modules & VBA 0 02-13-2006 10:30 AM
Audit Trail TKnight Modules & VBA 2 09-22-2004 12:35 AM
Audit trail Chimp8471 General 8 09-25-2003 04:51 AM




All times are GMT -8. The time now is 09:50 PM.


Microsoft Access Help
General
Tables
Queries
Forms
Reports
Macros
Modules & VBA
Theory & Practice
Access FAQs
Code Repository
Sample Databases
Video Tutorials

Sponsored Links

How to advertise

Media Kit


Powered by vBulletin®
Copyright ©2000 - 2017, Jelsoft Enterprises Ltd.
(c) copyright 2017 Access World