Recently, a customer requested that all changes to their form be logged and added to the email that is sent to the project manager associated with the project assigned to the form. I found some code to walk a form during the BeforeUpdate routine and look for and record fields that have been updated. Another user modified it to show friendly user names of the fields from the Status Bar property of the control if available, and also to show column 1 in Combo boxes and List boxes instead of column 0 with just the data (like an id number). I modified this code further to dynamically find the first column in the dropdown or listbox that was displayed to the user, and also the bound column. Here is the main function that would go in a Module:
Public Function fncChangedFields(frm As Access.Form) As String ' This function checks a form to see if any of the bound controls ' have had their values modified from their original values (from ' when the record was first loaded). If any have, a user friendly string ' with a list of the names of those controls' underlying fields OR the ' status bar property if available as a user friendly alternative name ' is returned. Prepended to the string is a timestamp and would also ' be a great place to put a user name if you have that information. ' If no fields have been changed, then a zero-length string is returned. ' ' Written by: Dirk Goldgar, DataGnostics LLC ' Copyright (c) 2011, DataGnostics LLC. ' You are free to use this code in your application, so long ' as the copyright notice remains unchanged. ' Additional code Written by: Mark Annett, ISPManSys LLC Copyright (c) 2011, ISPManSys LLC. ' Further modifications written by: Jonathan Halder Copyright (c) 2021, Halder Consulting, Inc. Dim ctl As Access.Control Dim varOldValue As Variant Dim varNewValue As Variant Dim strChangeList As String Dim strIntro As String Dim blnChanged As Boolean Dim lngError As Long ' In my case, I use a function to get my application user name. I am using the ' RDF framework my company developed which can pick up the user name from the ' windows login or has a completely self contained login plugin that you can ' set up and use that logged in user here strIntro = "At " & Now() & ", USER: " & RDF.UserLogin & " changed:" For Each ctl In frm.Controls ' Attachment fields are not supported with this code due to special processing ' that is needed. There are other underlying fields and there is no OldValue ' property for this content type. If ctl.ControlType <> 126 Then 'Skip because it is an attachment field blnChanged = False On Error Resume Next varOldValue = ctl.OldValue lngError = Err.Number On Error GoTo Err_Handler ' Note: this only picks up bound controls, and only the control types that have the ' OldValue property If lngError = 0 Then varNewValue = ctl.Value 'Store the New Value 'Has its value been changed? If IsNull(varOldValue) Then 'Handle the case when the Old Value is Null If Not IsNull(varNewValue) Then 'If the new Value isn't Null then it changed blnChanged = True 'Take care of what to display if Combo and List Boxes THAT ARE NOT MULTI SELECTION If ctl.ControlType = acComboBox Or ctl.ControlType = acListBox Then 'It is a combo OR List box varNewValue = Nz(getControlDisplayed(ctl, varNewValue), varNewValue) 'Use the first displayed column rather than the value End If If ctl.ControlType = acCheckBox Then varNewValue = IIf(varNewValue, "Checked", "Unchecked") 'Use the word checked or unchecked for checkboxes End If End If varOldValue = "Null" 'Set the word to be displayed to "Null" ElseIf IsNull(varNewValue) Then 'If the New Value is Null then it changed blnChanged = True varNewValue = "Null" 'Set the word to be displayed to "Null" If ctl.ControlType = acComboBox Or ctl.ControlType = acListBox Then 'It is a combo OR List box varOldValue = Nz(getControlDisplayed(ctl, varOldValue), varOldValue) 'Use the first displayed column End If If ctl.ControlType = acCheckBox Then varOldValue = IIf(varOldValue, "Checked", "Unchecked") 'Use the word checked or unchecked for checkboxes End If ElseIf varNewValue <> varOldValue Then 'Test if they Match or Not blnChanged = True If ctl.ControlType = acComboBox Or ctl.ControlType = acListBox Then 'It is a combo OR List box varOldValue = Nz(getControlDisplayed(ctl, varOldValue), varOldValue) 'Use the first displayed column varNewValue = Nz(getControlDisplayed(ctl, varNewValue), varNewValue) 'Use the first displayed column rather than the value End If If ctl.ControlType = acCheckBox Then varOldValue = IIf(varOldValue, "Checked", "Unchecked") 'Use the word checked or unchecked for checkboxes varNewValue = IIf(varNewValue, "Checked", "Unchecked") 'Use the word checked or unchecked for checkboxes End If End If If blnChanged Then strChangeList = strChangeList & Chr(13) & Chr(10) & " - " 'Add a line Feed If Not (ctl.StatusBarText = "") Then 'If they have Status Bar text use that strChangeList = strChangeList & ctl.StatusBarText & " - FROM " & varOldValue & " TO " & varNewValue Else strChangeList = strChangeList & ctl.Name & " - FROM " & varOldValue & " TO " & varNewValue End If End If End If Else ' Deal with Attachments being opened in edit mode by checking some sort of flag ' that you set if you do not already have a date modified field on the form. End If Next ctl If Len(strChangeList) > 0 Then ' Strip off leading comma+space and return the result. fncChangedFields = strIntro & strChangeList End If Exit_Point: Exit Function Err_Handler: MsgBox Err.Description, vbExclamation, "Error " & Err.Number Resume Exit_Point End Function Public Function getControlDisplayed(cb As Access.Control, val As Variant) As Variant ' Pass cb as either a combobox or list control, val as the value to lookup the displayed text for that value ' Note, val must be the same variable type as the bound column in the control ' .Value and .OldValue which are being used originally for this function are variants ' The function is being used to determine what to display to a non-programmer user of the app ' It returns null if it doesn't find a match. If there is only one column displayed it will ' simply return the value the function was passed Dim FirstColumnDisplayed As Integer, cw As Variant, cc As Integer, BoundColumn As Integer If Nz(cb.ColumnCount, 1) > 1 Then cw = Split(cb.ColumnWidths, ";") Do While UBound(cw) >= cc If Nz(cw(cc), "") = "" Or CLng(Nz(cw(cc), 0)) > 0 Then FirstColumnDisplayed = cc Exit Do End If cc = cc + 1 Loop Else getControlDisplayed = val Exit Function End If For cc = 1 To cb.ListCount If CStr(Nz(cb.Column(cb.BoundColumn - 1, cc - 1), "")) = CStr(Nz(val, "")) Then getControlDisplayed = cb.Column(FirstColumnDisplayed, cc - 1) Exit Function End If Next cc getControlDisplayed = Null End Function |
And here is the code in my form. I am calling the function each time the BeforeUpdate event occurs and is not cancelled. I have set up a collection which adds the string returned by the function each time the form is updated.
Option Compare Database Option Explicit Public POModifiedLog As VBA.Collection Private Sub Form_Open(Cancel As Integer) Set Me.POModifiedLog = New Collection End Sub Private Sub Form_BeforeUpdate(Cancel As Integer) If Not Cancel Then POModifiedLog.Add fncChangedFields(Me) End Sub |
And here is a sample of the output of my collection when concatenating all the strings together.
At 5/31/2021 4:49:02 PM, USER: Jon changed: - PO Taxable - FROM Unchecked TO Checked At 5/31/2021 4:49:31 PM, USER: Jon changed: - CY Add 1 - FROM Null TO 1.0% Darex: Corrosion Inhibitor - CY Add 1 Price - FROM Null TO 7.5 - CY Add 1 SKU - FROM Null TO NCAD - CY Add 1 Tax - FROM Y TO N - CY Add 1 Unit - FROM Null TO CY