Tracking Changes in both the main form and the subform

R

Rodger

All,

I am creating a module to add to existing database that will track any
change a user makes to the data. I have it working great with a single form
and I am sure it is easier than I am making it out to but I would now like
to make this work with subforms, maybe ever sub subforms . . . .

Here is my Function for the stand alone form. Any help would be greatly
appreciated.

TIA,
Rodger

Public Sub myHistory(frm As Form, myID)

Dim D As Control
Dim myDB, myRS, myNewRecord, myTable, myValue

Set myDB = CurrentDb()
Set myRS = myDB.openrecordset("HISTORY")

'Check each data entry control for change and record old value of
Control.
'Set the Array Counter
X = -1
For Each D In frm.Controls

' Only check data entry type controls.
X = X + 1
Select Case D.ControlType

Case acTextBox, acComboBox, acListBox, acOptionGroup
' Skip Updates field.
myValue = D.Value

'If D.Name = "Updates" Then GoTo TryNextD
If frm.NewRecord = True Then
myNewRecord = "New Record"
myRS.AddNew
myRS![HIS_USER] = useUserName
myRS![HIS_FIELD] = D.Name
myRS![HIS_FORM] = frm.Name
myRS![HIS_TABLE_ID] = myID 'CHANGE THIS
myRS![HIS_TABLE_NAME] = frm.RecordSource
myRS![HIS_OLD_VALUE] = "This is a new record"
myRS![HIS_NEW_VALUE] = D.Value
myRS![HIS_DATE_CHANGE] = Date
myRS![HIS_TIME_CHANGE] = Time()
myRS.Update
GoTo TryNextD 'Exit Sub
End If


' If control was previously Null, record "previous value was
blank."
If IsNull(myArray(X)) Then
myRS.AddNew
myRS![HIS_USER] = useUserName
myRS![HIS_FIELD] = D.Name
myRS![HIS_FORM] = frm.Name
myRS![HIS_TABLE_ID] = myID 'CHANGE THIS
myRS![HIS_TABLE_NAME] = frm.RecordSource
myRS![HIS_OLD_VALUE] = "Previous value was blank."
myRS![HIS_NEW_VALUE] = D.Value
myRS![HIS_DATE_CHANGE] = Date
myRS![HIS_TIME_CHANGE] = Time()
myRS.Update
ElseIf myValue <> myArray(X) Then
myRS.AddNew
myRS![HIS_USER] = useUserName
myRS![HIS_FIELD] = D.Name
myRS![HIS_FORM] = frm.Name
myRS![HIS_TABLE_ID] = myID 'CHANGE THIS
myRS![HIS_TABLE_NAME] = frm.RecordSource
myRS![HIS_OLD_VALUE] = myArray(X)
myRS![HIS_NEW_VALUE] = D.Value
myRS![HIS_DATE_CHANGE] = Date
myRS![HIS_TIME_CHANGE] = Time()
myRS.Update
End If
End Select
TryNextD:
Next D

End Sub
 
R

Rodger

I forgot to add theother module I have that actually gets the values of
each control. I would also like to make both of these a Function so I do
not have to put them on every form/subform.

ADDED CODE IS AT THE END!!!

All,

I am creating a module to add to existing database that will track any
change a user makes to the data. I have it working great with a single form
and I am sure it is easier than I am making it out to but I would now like
to make this work with subforms, maybe ever sub subforms . . . . Here is my
Function for the stand alone form.

Any help would be greatly appreciated.

TIA,
Rodger

'*********************************************************************

Public Sub myHistory(frm As Form, myID, sfrm As SubForm)

Dim D As Control
Dim myDB, myRS, myNewRecord, myTable, myValue

Set myDB = CurrentDb()
Set myRS = myDB.openrecordset("HISTORY")

'Check each data entry control for change and record old value of
Control.
'Set the Array Counter
X = -1
For Each D In frm.Controls

' Only check data entry type controls.
X = X + 1
Select Case D.ControlType

Case acTextBox, acComboBox, acListBox, acOptionGroup
' Skip Updates field.
myValue = D.Value

'If D.Name = "Updates" Then GoTo TryNextD
If frm.NewRecord = True Then
myNewRecord = "New Record"
myRS.AddNew
myRS![HIS_USER] = useUserName
myRS![HIS_FIELD] = D.Name
myRS![HIS_FORM] = frm.Name
myRS![HIS_TABLE_ID] = myID 'CHANGE THIS
myRS![HIS_TABLE_NAME] = frm.RecordSource
myRS![HIS_OLD_VALUE] = "This is a new record"
myRS![HIS_NEW_VALUE] = D.Value
myRS![HIS_DATE_CHANGE] = Date
myRS![HIS_TIME_CHANGE] = Time()
myRS.Update
GoTo TryNextD 'Exit Sub
End If


' If control was previously Null, record "previous value was
blank."
If IsNull(myArray(X)) Then
myRS.AddNew
myRS![HIS_USER] = useUserName
myRS![HIS_FIELD] = D.Name
myRS![HIS_FORM] = frm.Name
myRS![HIS_TABLE_ID] = myID 'CHANGE THIS
myRS![HIS_TABLE_NAME] = frm.RecordSource
myRS![HIS_OLD_VALUE] = "Previous value was blank."
myRS![HIS_NEW_VALUE] = D.Value
myRS![HIS_DATE_CHANGE] = Date
myRS![HIS_TIME_CHANGE] = Time()
myRS.Update
ElseIf myValue <> myArray(X) Then
myRS.AddNew
myRS![HIS_USER] = useUserName
myRS![HIS_FIELD] = D.Name
myRS![HIS_FORM] = frm.Name
myRS![HIS_TABLE_ID] = myID 'CHANGE THIS
myRS![HIS_TABLE_NAME] = frm.RecordSource
myRS![HIS_OLD_VALUE] = myArray(X)
myRS![HIS_NEW_VALUE] = D.Value
myRS![HIS_DATE_CHANGE] = Date
myRS![HIS_TIME_CHANGE] = Time()
myRS.Update
End If
End Select
TryNextD:
Next D

End Sub

'*********************************************************************

Public Sub myCurrent(frm As Form)
'Set MyForm = Me.Form
ReDim myArray(frm.Controls.Count - 1)
'On Err GoTo TryNextC
X = -1

For Each C In frm.Controls
X = X + 1
Select Case C.ControlType
Case acTextBox, acComboBox, acListBox, acOptionGroup 'Skip
Updates field.
'If C.Name = "Updates" Then GoTo TryNextC
myArray(X) = C.Value

End Select
TryNextC:
Next C

End Sub

'*********************************************************************
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Arrays 2

Top