T
Terry Reardon
Hi all:
My Problem:
I have an audit routine that monitors all user activity
while online with in the access 97 app. An example the
PostAudit routine is below, other utilitly routines do
string manipulation for me.
You will notice that I use "Hints" in the tag property for
forms that have Querys that are the record source for a
form. Forms based on tables do not have this hint. My
problems lies in the fact that I need to determine the
primary key or index for a perticuar recordset that is
being added,modified or deleted.
With tables I do not need to worried about this, but with
queries I do.
So, my question is:
How can I determine the primary or index keys of a form
with a recordset that is based on a query and not on a
table? I need to determine the primary keys of the result
set for insertion into an audit trail table, and right now
the only way I figure to do this is a work-around in the
tag property.
Any Ideas . . .
Example Code . . .
Executed on Delete Event: PostAudit "D", Me
----------------------------------------------------------
Public Sub PostAudit(actionCode As String, Optional frm As
Form, Optional auditComment = Null, Optional
requestComment = False)
On Error GoTo err_PostAudit
' Standard Audit Action Codes
' I = Login
' O = Logout
' U = Update Application
' M = Modify Record (automatically changed to A or E)
' A = Add New Record
' E = Edit Existing Record
' D = Delete Record
' R = Remove Record from List
' V = View Record
' S = System Function
' X = Audit Error, description place in comment field
' B = Background
Dim i As Long, errMsg
Dim audID As Long
Dim formID, tableID, recordID, recidHint As String
Dim dbs As Database, tdf As TableDef, idx As Index,
fld As field
Set dbs = CurrentDb
formID = Null
tableID = Null
recordID = Null
If varTableIDs = "" Then
InstallTableIDs
End If
'if form related audit, get form, table, and record
index
If actionCode = "D" Or actionCode = "M" Or actionCode
= "V" Then
formID = frm.Name
If actionCode = "V" Then
'viewing of a new (blank) record is not audited
If frm.NewRecord Then
Exit Sub
End If
End If
'determine table name and record index
On Error Resume Next
Set tdf = dbs.TableDefs(frm.RecordSource)
If Err.Number <> 0 Then
On Error GoTo err_PostAudit
'record source is a query, not a table, use
hint information
tableID = GetProperty(frm.Tag, "tableHint")
recidHint = GetProperty(frm.Tag, "recidHint")
If tableID = "" Or recidHint = "" Then
'if no hint information, report audit error
tableID = Null
auditComment = actionCode & ": Missing
audit hints in form: " & formID
actionCode = "X"
Else
'determine record index from the parsed
recidHint field
recordID = ""
For i = 1 To NumPieces(recidHint, ":")
recordID = recordID & ":" & frm
(GetPiece(recidHint, ":", i))
Next i
recordID = Mid(recordID, 2)
End If
Else
Set tdf = dbs.TableDefs(frm.RecordSource)
On Error GoTo err_PostAudit
tableID = frm.RecordSource
'determine record index from primary index key
recordID = ""
For Each idx In tdf.Indexes
If idx.Primary Then
For Each fld In idx.Fields
recordID = recordID & ":" & frm
(fld.Name)
Next fld
Exit For
End If
Next idx
recordID = Mid(recordID, 2)
End If
End If
'if M action is to a new record, record A for Add, if
to an existing record, record to E for Edit
If actionCode = "M" Then
actionCode = IIf(frm.NewRecord, "A", "E")
End If
'write audit record
audID = PostAuditRecord(actionCode, tableID, recordID,
auditComment, requestComment)
'if A or E action, write field changes
If actionCode = "A" Or actionCode = "E" Then
Dim ctl As Control
'check each valid data field on the form
For Each ctl In frm.Controls
If TypeOf ctl Is TextBox Or TypeOf ctl Is
ComboBox Or TypeOf ctl Is ListBox Or TypeOf ctl Is
CheckBox Or TypeOf ctl Is OptionGroup Then
'ignore calculated data fields
If Left(ctl.ControlSource, 1) <> "=" Then
PostAuditField audID, ctl.ControlName,
ctl.oldValue, ctl.value
End If
End If
Next ctl
End If
exit_PostAudit:
Exit Sub
err_PostAudit:
errMsg = Err.Description
On Error GoTo err_PostAudit_Abort
MsgBox "ERROR: PostAudit [1] .. " & errMsg
audID = PostAuditRecord("X", Null, Null, auditComment
& ":ERROR:" & Nz(formID) & ":" & Nz(tableID) & ":" & Nz
(recordID) & ":" & errMsg)
Resume exit_PostAudit
err_PostAudit_Abort:
MsgBox "ERROR: PostAudit [2] .. " & Err.Description
Resume exit_PostAudit
End Sub
My Problem:
I have an audit routine that monitors all user activity
while online with in the access 97 app. An example the
PostAudit routine is below, other utilitly routines do
string manipulation for me.
You will notice that I use "Hints" in the tag property for
forms that have Querys that are the record source for a
form. Forms based on tables do not have this hint. My
problems lies in the fact that I need to determine the
primary key or index for a perticuar recordset that is
being added,modified or deleted.
With tables I do not need to worried about this, but with
queries I do.
So, my question is:
How can I determine the primary or index keys of a form
with a recordset that is based on a query and not on a
table? I need to determine the primary keys of the result
set for insertion into an audit trail table, and right now
the only way I figure to do this is a work-around in the
tag property.
Any Ideas . . .
Example Code . . .
Executed on Delete Event: PostAudit "D", Me
----------------------------------------------------------
Public Sub PostAudit(actionCode As String, Optional frm As
Form, Optional auditComment = Null, Optional
requestComment = False)
On Error GoTo err_PostAudit
' Standard Audit Action Codes
' I = Login
' O = Logout
' U = Update Application
' M = Modify Record (automatically changed to A or E)
' A = Add New Record
' E = Edit Existing Record
' D = Delete Record
' R = Remove Record from List
' V = View Record
' S = System Function
' X = Audit Error, description place in comment field
' B = Background
Dim i As Long, errMsg
Dim audID As Long
Dim formID, tableID, recordID, recidHint As String
Dim dbs As Database, tdf As TableDef, idx As Index,
fld As field
Set dbs = CurrentDb
formID = Null
tableID = Null
recordID = Null
If varTableIDs = "" Then
InstallTableIDs
End If
'if form related audit, get form, table, and record
index
If actionCode = "D" Or actionCode = "M" Or actionCode
= "V" Then
formID = frm.Name
If actionCode = "V" Then
'viewing of a new (blank) record is not audited
If frm.NewRecord Then
Exit Sub
End If
End If
'determine table name and record index
On Error Resume Next
Set tdf = dbs.TableDefs(frm.RecordSource)
If Err.Number <> 0 Then
On Error GoTo err_PostAudit
'record source is a query, not a table, use
hint information
tableID = GetProperty(frm.Tag, "tableHint")
recidHint = GetProperty(frm.Tag, "recidHint")
If tableID = "" Or recidHint = "" Then
'if no hint information, report audit error
tableID = Null
auditComment = actionCode & ": Missing
audit hints in form: " & formID
actionCode = "X"
Else
'determine record index from the parsed
recidHint field
recordID = ""
For i = 1 To NumPieces(recidHint, ":")
recordID = recordID & ":" & frm
(GetPiece(recidHint, ":", i))
Next i
recordID = Mid(recordID, 2)
End If
Else
Set tdf = dbs.TableDefs(frm.RecordSource)
On Error GoTo err_PostAudit
tableID = frm.RecordSource
'determine record index from primary index key
recordID = ""
For Each idx In tdf.Indexes
If idx.Primary Then
For Each fld In idx.Fields
recordID = recordID & ":" & frm
(fld.Name)
Next fld
Exit For
End If
Next idx
recordID = Mid(recordID, 2)
End If
End If
'if M action is to a new record, record A for Add, if
to an existing record, record to E for Edit
If actionCode = "M" Then
actionCode = IIf(frm.NewRecord, "A", "E")
End If
'write audit record
audID = PostAuditRecord(actionCode, tableID, recordID,
auditComment, requestComment)
'if A or E action, write field changes
If actionCode = "A" Or actionCode = "E" Then
Dim ctl As Control
'check each valid data field on the form
For Each ctl In frm.Controls
If TypeOf ctl Is TextBox Or TypeOf ctl Is
ComboBox Or TypeOf ctl Is ListBox Or TypeOf ctl Is
CheckBox Or TypeOf ctl Is OptionGroup Then
'ignore calculated data fields
If Left(ctl.ControlSource, 1) <> "=" Then
PostAuditField audID, ctl.ControlName,
ctl.oldValue, ctl.value
End If
End If
Next ctl
End If
exit_PostAudit:
Exit Sub
err_PostAudit:
errMsg = Err.Description
On Error GoTo err_PostAudit_Abort
MsgBox "ERROR: PostAudit [1] .. " & errMsg
audID = PostAuditRecord("X", Null, Null, auditComment
& ":ERROR:" & Nz(formID) & ":" & Nz(tableID) & ":" & Nz
(recordID) & ":" & errMsg)
Resume exit_PostAudit
err_PostAudit_Abort:
MsgBox "ERROR: PostAudit [2] .. " & Err.Description
Resume exit_PostAudit
End Sub