The following is an example of how to implement a simple audit trail within an Excel macro enabled workbook. The aim is to capture changes made to individual cells, so we have a before and after picture of what was changed. In addition to this we are going to record every time the spreadsheet is opened, closed, and saved. All the changes will be logged in an external text file located in the same directory as the workbook that will house the code.
First, in a new or existing Excel workbook create a class called csLogger and add the following code to the class:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 |
Option Explicit Option Compare Text Private Type udtLogEntry Date As String * 22 NewCellValue As String * 30 OldCellValue As String * 30 CellRef As String * 15 UserName As String * 10 SheetName As String * 20 NewFormula As String * 40 OldFormula As String * 40 ChangeType As String * 12 End Type Private mudtEntry As udtLogEntry Private Const CSTR_CELL_ADJUSTMENT_TYPE As String = "Cell" Private Const CSTR_LOG_FILENAME_SUFFIX As String = "_log.txt" Public Sub LogSheetChangeEvent(ByVal Sh As Object, ByVal Target As Range) On Error GoTo ERR_HANDLER: Dim strText As String If Not ThisWorkbook.ReadOnly Then If (Target.Rows.Count = 1) And (Target.Columns.Count = 1) Then mudtEntry.SheetName = CStr(Sh.Name) mudtEntry.CellRef = CStr(Target.Address) mudtEntry.ChangeType = CSTR_CELL_ADJUSTMENT_TYPE mudtEntry.Date = CStr(Now()) mudtEntry.NewCellValue = CStr(Target.Value) mudtEntry.UserName = Environ("username") mudtEntry.NewFormula = CStr(Target.Formula) strText = BuildLogString(mudtEntry.Date, mudtEntry.NewCellValue, _ mudtEntry.OldCellValue, mudtEntry.CellRef, _ mudtEntry.UserName, mudtEntry.SheetName, mudtEntry.OldFormula, _ mudtEntry.NewFormula, mudtEntry.ChangeType) Call fnAddToFile(strText) End If End If EXIT_HERE: Exit Sub ERR_HANDLER: GoTo EXIT_HERE End Sub Public Sub LogSheetSelectionChangeEvent(ByVal Sh As Object, ByVal Target As Range) On Error Resume Next If Not ThisWorkbook.ReadOnly Then If (Target.Rows.Count = 1) And (Target.Columns.Count = 1) Then mudtEntry.OldCellValue = CStr(Target.Value) mudtEntry.OldFormula = CStr(Target.Formula) End If End If End Sub Public Sub LogEventAction(ByVal strEvent As String) Dim udtEntry As udtLogEntry udtEntry.Date = Now() udtEntry.ChangeType = strEvent udtEntry.UserName = Environ("username") If Not fnAddToFile(udtEntry.Date & "," & udtEntry.UserName & "," & udtEntry.ChangeType) Then Debug.Print "Failed to log event" End If End Sub Private Function fnAddToFile(ByVal strText As String) As Boolean On Error GoTo ERR_HANDLER: Dim intHandle As Integer Dim strFileName As String fnAddToFile = False If ThisWorkbook.ReadOnly Then fnAddToFile = False GoTo EXIT_HERE End If intHandle = FreeFile strFileName = Mid(ThisWorkbook.Name, 1, InStr(1, ThisWorkbook.Name, ".") - 1) strFileName = strFileName & CSTR_LOG_FILENAME_SUFFIX strFileName = ThisWorkbook.Path & Chr(92) & strFileName If Not IsLogFilePresent(strFileName) Then Open strFileName For Append As #intHandle Dim udtHeader As udtLogEntry Dim strTitles As String udtHeader.SheetName = "Sheet Name" udtHeader.Date = "Date & Time" udtHeader.CellRef = "Cell Ref" udtHeader.SheetName = "Sheetname" udtHeader.UserName = "UserName" udtHeader.NewCellValue = "New Value" udtHeader.OldCellValue = "Old Value" udtHeader.NewFormula = "New Value Formula" udtHeader.OldFormula = "Old Value Formula" udtHeader.ChangeType = "Type" strTitles = BuildLogString(udtHeader.Date, udtHeader.NewCellValue, _ udtHeader.OldCellValue, udtHeader.CellRef, _ udtHeader.UserName, udtHeader.SheetName, _ udtHeader.OldFormula, udtHeader.NewFormula, _ udtHeader.ChangeType) Print #intHandle, strTitles Print #intHandle, strText Close #intHandle Else Open strFileName For Append As #intHandle Print #intHandle, strText Close #intHandle End If fnAddToFile = True EXIT_HERE: Exit Function ERR_HANDLER: fnAddToFile = False GoTo EXIT_HERE End Function Private Function BuildLogString(ByVal strDate As String, ByVal strNew As String, ByVal strOld As String, _ ByVal strRef As String, ByVal strName As String, ByVal strSheet As String, _ ByVal strOldFormula As String, ByVal strNewFormula As String, ByVal strChangeType As String) As String Dim strText As String On Error Resume Next strSheet = UCase(strSheet) BuildLogString = _ strDate & "," & strName & "," & strChangeType & "," & strSheet & "," & strRef & ", " & strNew & "," & strOld & _ "," & strNewFormula & "," & strOldFormula End Function Private Function IsLogFilePresent(ByVal strFile As String) As Boolean On Error GoTo ERR_HANDLER: IsLogFilePresent = False If Trim(Dir(strFile)) <> "" Then IsLogFilePresent = True Else IsLogFilePresent = False End If EXIT_HERE: Exit Function ERR_HANDLER: IsLogFilePresent = False GoTo EXIT_HERE End Function |
Next, go to the ThisWorkbook code module of your workbook and add the following code. If you already have existing code in this module, then add the lines below individually to their respective events:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 |
Option Explicit Private mObjLogger As csLogger Private Sub Workbook_BeforeClose(Cancel As Boolean) If Not mObjLogger Is Nothing Then mObjLogger.LogEventAction ("CLOSE") Set mObjLogger = Nothing End If End Sub Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) If Not mObjLogger Is Nothing Then mObjLogger.LogEventAction ("SAVE") End If End Sub Private Sub Workbook_Open() Set mObjLogger = New csLogger mObjLogger.LogEventAction ("OPEN") End Sub Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) If Not mObjLogger Is Nothing Then mObjLogger.LogSheetChangeEvent Sh, Target End If End Sub Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range) If Not mObjLogger Is Nothing Then mObjLogger.LogSheetSelectionChangeEvent Sh, Target End If End Sub |
If you save the workbook, close and then reopen, you should see the code in action as a text file will appear next to where the workbook is saved. You can go ahead and edit some of the cells in the workbook, and your changes should start to show up as log entries in the text file.
Thank you for reading this post. Please take time to read the disclaimer about content found on this site.
Share :
