Option Compare Database

Option Explicit

 

Sub TrackChanges(F As Form)

    Dim ctl As Control, frm As Form

    Dim MyField As String, MyKey As Long, MyTable As String

    Dim db As DAO.Database, rs As DAO.Recordset

    On Error Resume Next

    Set frm = F

    Set db = CurrentDb

    Set rs = db.OpenRecordset("tbl__ChangeTracker")

    With frm

        MyTable = .Tag

        ' find the primary key & its value, based on the Tag

        For Each ctl In .Controls

            If ctl.Tag = "PK" Then

                MyField = ctl.Name

                MyKey = ctl

                Exit For

            End If

        Next ctl

        For Each ctl In .Controls

            ' inspect only data-bound controls

            Select Case ctl.ControlType

                Case acTextBox, acComboBox, acCheckBox

                    If Nz(ctl.ControlSource, "") > "" Then

                        ' if changed, record both old & new values

                        If Nz(ctl.OldValue, "") <> Nz(ctl, "") Then

                            rs.AddNew

                            rs!FormName = .Name

                            rs!MyTable = MyTable

                            rs!MyField = MyField

                            rs!MyKey = MyKey

                            rs!ChangedOn = Now()

                            rs!FieldName = ctl.Name

                            If ctl.ControlType = acCheckBox Then

                                rs!Field_OldValue = YesOrNo(ctl.OldValue)

                                rs!Field_NewValue = YesOrNo(ctl)

                            Else

                                rs!Field_OldValue = Left(Nz(ctl.OldValue, ""), 255)

                                rs!Field_NewValue = Left(Nz(ctl, ""), 255)

                            End If

                            rs!UserChanged = UserName()

                            rs!CompChanged = CompName()

                            rs.Update

                        End If

                    End If

            End Select

        Next ctl

    End With

    rs.Close

    Set rs = Nothing

    Set db = Nothing

End Sub

 

Private Function YesOrNo(v) As String

    Select Case v

        Case -1

            YesOrNo = "Yes"

        Case 0

            YesOrNo = "No"

    End Select

End Function