Hi Peter
What you are trying to do is not complicated. You use the before update
event to write the change to a separate table. I use two tables. If it is
not a memo field, it goes in one table where every changed field is treated
as a text field. If it is a memo field it goes in another table.
I did a cut and paste from an application I used. This is what is in each
form.
Private Sub Form_BeforeUpdate(Cancel As Integer)
Dim intKey As Integer '
Primary Key Value
Dim strKeyName As String ' Table
name of the primary key in the form
Dim strOptional As String ' Option
1 for additional data
Dim strFormName As String ' Full
form name including reference to parent forms if a subform
On Error GoTo Error_Form_BeforeUpdate
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Change for each form
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
strKeyName = "tblPeople.PersonNo" ' Table
Name of the field for the Primary key
intKey = Me.PersonNo ' PK
value on the form
strOptional = "Person changed was " & Me.txtName '
Cancatenated Descriptio
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' Find the form name. Check if it is a subform and add the name to the
string
strFormName = Me.Name ' Name
of the form
Set frmToCheck = Me ' Name
of this form
' Examine the form to see if it is a subform. Create a cancatenated
string of the form!subform name
CheckSubForm:
If funIsSubForm(frmToCheck) = True Then ' Check
if it is a subform
strFormName = Me.Parent.Name & "!" & strFormName ' Add
the parent to the string
GoTo CheckSubForm
End If
' Run the update routine
Call funLogTrans(Me, _
intKey, _
strFormName, _
strKeyName, _
strOptional)
' Me is the form passing the information
' MyKey is the value of the PK
' strFormName is the name of the form being
modified including full path for subforms
' strKeyName is the name of the Primary Key
field in the table e.g. "tblPeople.PersonNo"
' strOptional1 is the cancatenated descriptive
string.
Exit_Form_BeforeUpdate:
Exit Sub
Error_Form_BeforeUpdate:
MsgBox "Error in Form_BeforeUpdate: " & Err.Number & " - " &
Err.Description
Resume Exit_Form_BeforeUpdate
End Sub
This is in a separate module.
Option Compare Database
Option Explicit
Public frmToCheck As Form
Public Function funLogTrans(frm As Form, _
intKey As Integer, _
strFormName As String, _
strKeyName As String, _
Optional strOptional As String) _
As Boolean
' Frm is the form passing the information
' intKey is the value of the PK
' strFormName is the name of the form being
modified including full path for subforms
' strKeyName is the name of the Primary Key
field in the table e.g. "tblPeople.PersonNo"
' strOptional1 is the cancatenated descriptive
string.
Dim dbs As DAO.Database
Dim ctlCtrl As Control
Dim MyMsg As String
Dim strHist As String
Dim lngOldValue As Long
Dim lngNewValue As Long
' Loop through controls to find ones that changed
For Each ctlCtrl In frm.Controls
If (funActiveCtrl(ctlCtrl)) Then ' Check
it is an updateable control
If IsNoOldValue(ctlCtrl) = True Then ' Is
the oldvalue valid for this control
If ctlCtrl.Enabled = True Then ' Is
the control enabled.
If ((ctlCtrl.Value <> ctlCtrl.OldValue) _
Or (IsNull(ctlCtrl) And Not IsNull(ctlCtrl.OldValue)) _
Or (Not IsNull(ctlCtrl) And IsNull(ctlCtrl.OldValue)))
Then
lngNewValue = Len(IIf(IsNull(ctlCtrl), 0, ctlCtrl))
lngOldValue = Len(IIf(IsNull(ctlCtrl.OldValue), 0,
ctlCtrl.OldValue))
If lngOldValue > 255 Or lngNewValue > 255 Then
' If a memo, write to that table
strHist = "tblHistMemo"
' Memo table
Else
strHist = "tblHist"
' Non memo table
End If
' This function creates new history records
Call funAddHist(strHist, _
intKey, _
strFormName, _
strKeyName, _
ctlCtrl, _
strOptional)
' strHist = Select which table to
enter data into
' MyKey is the value of the PK
' strFormName is the name of the
form being modified including full path for subforms
' strKeyName is the name of the
Primary Key field in the table e.g. "tblPeople.PersonNo"
' ctlCtrl is the control that changed
' strOptional1 is the cancatenated
descriptive string
End If
End If
End If
End If
Next ctlCtrl
funLogTrans = True 'Let
User know sucess
End Function
Public Function funActiveCtrl(ctl As Control) As Boolean
' This function checks what type of control is being examined. If it is not
an updateable type of control, it
' sets the function to false.
Select Case ctl.ControlType
Case Is = acTextBox
funActiveCtrl = True
Case Is = acLabel
Case Is = acRectangle
Case Is = acLine
Case Is = acImage
Case Is = acCommandButton
Case Is = acOptionButton
Case Is = acCheckBox
funActiveCtrl = True
Case Is = acOptionGroup
Case Is = acBoundObjectFrame
Case Is = acListBox
funActiveCtrl = True
Case Is = acComboBox
funActiveCtrl = True
Case Is = acSubform
Case Is = acObjectFrame
Case Is = acPageBreak
Case Is = acPage
Case Is = acCustomControl
Case Is = acToggleButton
Case Is = acTabCtl
End Select
End Function
Public Function funAddHist(strHist As String, _
intKey As Integer, _
strFormName As String, _
strKeyName As String, _
ctlCtrl As Control, _
Optional strOptional As String)
' strHist = Select which table to enter data into
' MyKey is the value of the PK
' strFormName is the name of the form being
modified including full path for subforms
' strKeyName is the name of the Primary Key
field in the table e.g. "tblPeople.PersonNo"
' ctlCtrl is the name of the control that changed
' strOptional1 is the cancatenated descriptive
string.
' This function creates new history records
Dim dbs As DAO.Database
Dim tblHistTable As DAO.Recordset
Set dbs = CurrentDb
Set tblHistTable = dbs.OpenRecordset(strHist, dbOpenDynaset) ' Open
either the memo or normal history table
With tblHistTable
.AddNew
!DateChange = Now()
!PersonNo = Forms!frmMenu.txtUserPersonNo
!FormName = strFormName
!KeyName = strKeyName
!Key = intKey
!FieldName = ctlCtrl.Name
' !UserId = Environ("Username") 'To pick up the environmental
user ID
!OldValue = ctlCtrl.OldValue
!NewValue = ctlCtrl.Value
!Optional = strOptional
.Update
End With
End Function
Public Function funAddHistSQLUpdate _
(strFormName As String, _
strPK As String, _
intKey As Integer, _
strFieldName As String, _
strOldValue As String, _
strNewValue As String, _
Optional strOptional As String)
' strFormName is the name of the form being
modified including full path for subforms
' strPK is the name of the Primary Key field in
the table e.g. "tblPeople.PersonNo"
' intKey is the value of the PK
' strFieldName is the name of the control that
changed
' strOldValue is the old value
' strNewValue is the new value
' strOptional is the cancatenated descriptive
string.
Dim lngNewValue As Long
Dim lngOldValue As Long
Dim strHist As String
' Decide which table to insert the records
lngNewValue = Len(NewValue)
lngOldValue = Len(OldValue)
If lngOldValue > 255 Or lngNewValue > 255 Then ' If a memo,
write to that table
strHist = "tblHistMemo" ' Memo table
Else
strHist = "tblHist" ' Non memo
table
End If
' This function creates new history records
Dim dbs As DAO.Database
Dim tblHistTable As DAO.Recordset
Set dbs = CurrentDb
Set tblHistTable = dbs.OpenRecordset(strHist, dbOpenDynaset) ' Open
either the memo or normal history table
With tblHistTable
.AddNew
!DateChange = Now()
!PersonNo = Forms!frmMenu.txtUserPersonNo
!FormName = strFormName
!KeyName = strPK
!Key = intKey
!FieldName = strFieldName
' !UserId = Environ("Username") 'To pick up the environmental
user ID
!OldValue = strOldValue
!NewValue = strNewValue
!Optional = strOptional
.Update
End With
End Function
Public Function IsNoOldValue(ctlTest As Control) As Boolean
' Checks to see if the old value is valid for this control. If the field is
a linked field, there will be no value
' There is an article at
http://groups.google.com.au/group/c...197599675df/37df246c541b0042#37df246c541b0042
Dim strTestValue As String
On Error Resume Next
strTestValue = ctlTest.OldValue
IsNoOldValue = (Err.Number = 0)
End Function
Sub WriteHistory(strTableName As String, strPK As String, strFieldName As
String, strFormName As String, _
Optional strWhere As String, Optional blnMoreUpdates As
Boolean)
Dim rstOld As Recordset ' The old data from the temp
table
Dim rstNew As Recordset ' The new data from the real
table
Dim strOldTable As String ' SQL to retrieve old data
and populate the recordset
Dim strNewTable As String ' SQL to retrieve new data
and populate the recordset
Dim strCriteria As String ' The criteria to find the
new record
Dim strTempTable As String ' The name of the temporary
table
Dim intKey As Integer ' Value of the primary key
Dim strOldValue As String ' Value before the change
Dim strNewValue As String ' Value after the change
Dim strOptional As String ' Optional information
Dim dbs As Database
Dim fld As Field ' Used to loop through all
the fields in a record
On Error GoTo Error_WriteHistory
strTempTable = "temp" & strTableName ' Name of the temporary
table with the old data
' Create SQL statements for each recordset
strOldTable = "SELECT * " & " FROM " & strTempTable & _
" WHERE " & strTempTable & "." & strWhere
strNewTable = "SELECT * " & " FROM " & strTableName & _
" WHERE " & strTableName & "." & strWhere
' Create the recordsets
Set dbs = CurrentDb
Set rstOld = dbs.OpenRecordset(strOldTable)
Set rstNew = dbs.OpenRecordset(strNewTable)
' Handle the situation where there is no old record. This is a new
monthly record
If rstOld.EOF = True Then
rstNew.MoveFirst
intKey = rstNew.Fields(strPK)
strOptional = ""
' Loop through the fields and put a 0 in the old record field
For Each fld In rstNew.Fields
strOldValue = 0 ' Old value
(was null as there was no record)
strNewValue = fld ' New value
strFieldName = fld.Name ' Field name
If strOldValue <> strNewValue Then ' Check if
there is a new value or whether it is blank
Call funAddHistSQLUpdate _
(strFormName, _
strPK, _
intKey, _
strFieldName, _
strOldValue, _
strNewValue, _
strOptional) ' Add a
history record
End If
Next
blnMoreUpdates = False ' No more
updates so delete the temp table
GoTo After_Write ' Skip the
update for existing records
End If
' Handles the situation where there is an old record. Compare values
where an existing record exists
strCriteria = strPK & " = " & rstOld.Fields(strPK) ' Create the
criteria string
rstNew.FindFirst strCriteria ' Find the
new record
rstOld.MoveFirst
While Not rstOld.EOF '
Find the old record
strCriteria = strPK & " = " & rstOld.Fields(strPK) ' Create
the criteria string
rstNew.MoveFirst
rstNew.FindFirst strCriteria '
Find the new record
For Each fld In rstNew.Fields '
Loop through the fields in the record
strFieldName = fld.Name '
Name of the field
If rstNew.Fields(strFieldName) <>
rstOld.Fields(strFieldName) Then ' Compare the records
intKey = rstNew.Fields(strPK)
strOldValue = rstOld.Fields(strFieldName)
strNewValue = rstNew.Fields(strFieldName)
strOptional = ""
Call funAddHistSQLUpdate _
(strFormName, _
strPK, _
intKey, _
strFieldName, _
strOldValue, _
strNewValue, _
strOptional)
End If
Next
rstOld.MoveNext '
Move to the next record
Wend
After_Write:
'Clean up
Set rstNew = Nothing
Set rstOld = Nothing
Set dbs = Nothing
'If finished with history updates delete the table
If blnMoreUpdates <> True Then
If funTableExists(strTableName) Then
subRunSelectQuery (strTableName) '
Delete the temporary table
End If
End If
Exit_WriteHistory:
Exit Sub
Error_WriteHistory:
MsgBox Err.Number & " " & Err.Description
Resume Exit_WriteHistory
End Sub
Sub subLogReport(strReportName As String)
Set dbs = CurrentDb
Set tblHistoryReport = dbs.OpenRecordset("tblHistoryReport",
dbOpenDynaset) ' Open the report history table
' Create the history record
With tblHistoryReport
.AddNew
!DateRan = Now()
!PersonNo = Forms!frmMenu.txtUserPersonNo
!ReportName = strReportName
.Update
End With
End Sub
You might have to play with it a bit but see how it goes.
Cheers
Neville Turbit
www.projectperfect.com.au