Query help

[Parfy]

Hi all,

I have built an audit solution to log changes made to data in forms. This all works fine, however I have a problem that people want access to data in a table format, which is based on a Query. Is the any way to amend the below code / make new code to incorporate a way to audit changes made to data via a query?

The track changes runs on all fields that want to be audited and change reason runs after update of form to log the reason for the amendment.

Many thanks

Option Compare Database
Option Explicit
Private Declare Function apiGetUserName Lib "advapi32.dll" Alias _
"GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Function fOSUserName() As String
' Returns the login name for Adminstrator use
Dim lngLen As Long, lngX As Long
Dim strUserName As String
strUserName = String$(254, 0)
lngLen = 255
lngX = apiGetUserName(strUserName, lngLen)
If (lngX > 0) Then
fOSUserName = Left$(strUserName, lngLen - 1)
Else
fOSUserName = vbNullString
End If
End Function


Function TrackChanges()
Dim db As Database
Dim rs As Recordset
Dim strsql As String
Dim strctl As String

strctl = Screen.ActiveControl.Name
strsql = "SELECT Audit.* FROM Audit;"
Set db = CurrentDb()
Set rs = db.OpenRecordset(strsql, dbOpenDynaset)
If rs.RecordCount > 0 Then rs.MoveLast
With rs
.AddNew
rs!FormName = Screen.ActiveForm.Name
rs!ControlName = strctl
rs!DateChanged = Date
rs!TimeChanged = Time()
rs!PriorInfo = Screen.ActiveControl.OldValue
rs!NewInfo = Screen.ActiveControl.Value
rs!CurrentUser = fOSUserName
rs!recordid = Screen.ActiveForm.[Employee ID]
.Update
End With
Set db = Nothing
Set rs = Nothing
End Function


Function ChangeReason()
Dim db As Database
Dim rs As Recordset
Dim strsql As String
Dim strReason As String
strReason = InputBox("Reason For Changes")
strsql = "SELECT Audit.* FROM Audit;"
Set db = CurrentDb()
Set rs = db.OpenRecordset(strsql, dbOpenDynaset)
If rs.RecordCount > 0 Then rs.MoveLast
With rs
.AddNew
rs!recordid = Screen.ActiveForm.[Employee ID]
rs!DateChanged = Date
rs!TimeChanged = Time()
rs!CurrentUser = fOSUserName
rs!reason = strReason
.Update
End With
Set db = Nothing
Set rs = Nothing
End Function

 

[Trevor G]

I use the following code to do an audit trail placing all in a table, although I make the table hidden, it will tell you which controls have been updated and when, what the previous values where and also the new one.

Public Function WriteAudit(frm As Form, lngID As Long) As Boolean
On Error GoTo err_WriteAudit
Dim ctlC As Control
Dim strSQL As String
Dim bOK As Boolean

bOK = False

DoCmd.SetWarnings False

' For each control.
For Each ctlC In frm.Controls
If TypeOf ctlC Is TextBox Or TypeOf ctlC Is ComboBox Then
If ctlC.Value <> ctlC.OldValue Or IsNull(ctlC.OldValue) Then
If Not IsNull(ctlC.Value) Then
strSQL = "INSERT INTO tblAudit ( ID, FieldChanged, FieldChangedFrom, FieldChangedTo, User, DateofHit ) " & _
" SELECT " & lngID & " , " & _
"'" & ctlC.Name & "', " & _
"'" & ctlC.OldValue & "', " & _
"'" & ctlC.Value & "', " & _
"'" & GetUserName_TSB & "', " & _
"'" & Now & "'"
'Debug.Print strSQL
DoCmd.RunSQL strSQL
End If
End If
End If
Next ctlC

WriteAudit = bOK

exit_WriteAudit:
DoCmd.SetWarnings True
Exit Function

err_WriteAudit:
MsgBox Err.Description
Resume exit_WriteAudit

End Function

Hope this helps

 

[Parfy]

Thanks for that, so will the above created an audit of changes made in a queries results? The output of the query is viewed as a table not in a form.

Lee

 

[Trevor G]

Create a Table and add the field headings indicated in my example and then behind the forms it will run direct to the table. There are

tblAudit ( ID, FieldChanged, FieldChangedFrom, FieldChangedTo, User, DateofHit )


If you need an example of the database then send a thread.