From 1713533974a501361c2b4e19197b2cf60080460a Mon Sep 17 00:00:00 2001 From: joyfullservice Date: Tue, 9 Mar 2021 13:27:30 -0600 Subject: [PATCH] Implement conditional error handling This allows us to set an option to allow the code to break on errors. This should help with troubleshooting issues when other users are using the add-in. --- .../modules/clsDbNavPaneGroup.bas | 4 ++-- .../modules/clsDbTheme.bas | 4 ++-- .../modules/clsDbVbeReference.bas | 2 +- .../modules/clsDevMode.bas | 10 +++++----- Version Control.accda.src/modules/modHash.bas | 6 +++--- .../modules/modImportExport.bas | 4 ++-- .../modules/modObjects.bas | 17 +++++++++++++++-- .../modules/modSanitize.bas | 2 +- 8 files changed, 31 insertions(+), 18 deletions(-) diff --git a/Version Control.accda.src/modules/clsDbNavPaneGroup.bas b/Version Control.accda.src/modules/clsDbNavPaneGroup.bas index 3245c2f8..0049b28f 100644 --- a/Version Control.accda.src/modules/clsDbNavPaneGroup.bas +++ b/Version Control.accda.src/modules/clsDbNavPaneGroup.bas @@ -144,7 +144,7 @@ Private Sub ClearExistingNavGroups() Dim rst As DAO.Recordset Dim strSql As String - On Error Resume Next + If DebugMode Then On Error GoTo 0 Else On Error Resume Next ' Get SQL for query of NavPaneGroup objects Set dbs = CodeDb @@ -491,7 +491,7 @@ Private Sub IDbComponent_Upgrade() Dim colNew As Collection Dim dblVersion As Double - On Error Resume Next + If DebugMode Then On Error GoTo 0 Else On Error Resume Next ' Get version If Not m_dItems Is Nothing Then diff --git a/Version Control.accda.src/modules/clsDbTheme.bas b/Version Control.accda.src/modules/clsDbTheme.bas index 5a1a51d4..32c47055 100644 --- a/Version Control.accda.src/modules/clsDbTheme.bas +++ b/Version Control.accda.src/modules/clsDbTheme.bas @@ -52,7 +52,7 @@ Private Sub IDbComponent_Export() Dim rstAtc As Recordset2 Dim strSql As String - On Error Resume Next + If DebugMode Then On Error GoTo 0 Else On Error Resume Next ' Query theme file details strSql = "SELECT [Data] FROM MSysResources WHERE [Name]='" & m_Name & "' AND Extension='" & m_Extension & "'" @@ -124,7 +124,7 @@ Private Sub IDbComponent_Import(strFile As String) Dim strSql As String Dim blnIsFolder As Boolean - On Error Resume Next + If DebugMode Then On Error GoTo 0 Else On Error Resume Next ' Are we dealing with a folder, or a file? blnIsFolder = (Right$(strFile, 5) <> ".thmx") diff --git a/Version Control.accda.src/modules/clsDbVbeReference.bas b/Version Control.accda.src/modules/clsDbVbeReference.bas index 3d38430b..da1bfb1e 100644 --- a/Version Control.accda.src/modules/clsDbVbeReference.bas +++ b/Version Control.accda.src/modules/clsDbVbeReference.bas @@ -67,7 +67,7 @@ Private Sub IDbComponent_Import(strFile As String) ' Only import files with the correct extension. If Not strFile Like "*.json" Then Exit Sub - On Error Resume Next + If DebugMode Then On Error GoTo 0 Else On Error Resume Next ' Read in references from file Set dFile = ReadJsonFile(strFile) diff --git a/Version Control.accda.src/modules/clsDevMode.bas b/Version Control.accda.src/modules/clsDevMode.bas index 063b10d7..84f11e9d 100644 --- a/Version Control.accda.src/modules/clsDevMode.bas +++ b/Version Control.accda.src/modules/clsDevMode.bas @@ -229,7 +229,7 @@ Public Sub LoadFromExportFile(strFile As String) Dim udtDevModeBuffer As tDevModeBuffer Dim udtDevNamesBuffer As tDevNamesBuffer - On Error Resume Next + If DebugMode Then On Error GoTo 0 Else On Error Resume Next ' Blocks: 1=Mip, 2=DevMode, 3=DevNames @@ -349,7 +349,7 @@ Public Sub LoadFromPrinter(strPrinter As String) Dim udtBuffer As tDevModeBuffer Dim objPrinter As Access.Printer - On Error Resume Next + If DebugMode Then On Error GoTo 0 Else On Error Resume Next ' Clear our existing devmode structures ClearStructures @@ -760,7 +760,7 @@ Public Sub SetPrinterOptions(objFormOrReport As Object, dSettings As Dictionary) Dim strDevModeExtra As String Dim tBuffer As tDevModeBuffer - On Error Resume Next + If DebugMode Then On Error GoTo 0 Else On Error Resume Next ' Make sure we are using the correct object type If TypeOf objFormOrReport Is Access.Report Then @@ -886,7 +886,7 @@ Public Sub ApplySettings(dSettings As Dictionary) Dim dItems As Dictionary Dim strPrinter As String - On Error Resume Next + If DebugMode Then On Error GoTo 0 Else On Error Resume Next ' Set the properties in the DevNames structure. ' Note that this simply sets the printer to one with a matching name. It doesn't try to reconstruct @@ -1035,7 +1035,7 @@ Public Function AddToExportFile(strFile As String) As String Dim blnFound As Boolean Dim blnInBlock As Boolean - On Error Resume Next + If DebugMode Then On Error GoTo 0 Else On Error Resume Next ' Load data from export file strData = ReadFile(strFile) diff --git a/Version Control.accda.src/modules/modHash.bas b/Version Control.accda.src/modules/modHash.bas index 3bb140d4..72c3eaf3 100644 --- a/Version Control.accda.src/modules/modHash.bas +++ b/Version Control.accda.src/modules/modHash.bas @@ -118,7 +118,7 @@ VBErrHandler: ErrHandler: CatchAny eelCritical, "Error hashing! " & errorMessage & ". Algorithm: " & HashingAlgorithm, ModuleName & ".NGHash", True, True - Resume ExitHandler + GoTo ExitHandler End Function @@ -131,14 +131,14 @@ End Function '--------------------------------------------------------------------------------------- ' Private Function HashBytes(Data() As Byte, Optional HashingAlgorithm As String = "SHA512") As Byte() - On Error Resume Next + If DebugMode Then On Error GoTo 0 Else On Error Resume Next HashBytes = NGHash(VarPtr(Data(LBound(Data))), UBound(Data) - LBound(Data) + 1, HashingAlgorithm) If Catch(9) Then HashBytes = NGHash(VarPtr(Null), UBound(Data) - LBound(Data) + 1, HashingAlgorithm) CatchAny eelCritical, "Error hashing data!", ModuleName & ".HashBytes", True, True End Function Private Function HashString(str As String, Optional HashingAlgorithm As String = "SHA512") As Byte() - On Error Resume Next + If DebugMode Then On Error GoTo 0 Else On Error Resume Next HashString = NGHash(StrPtr(str), Len(str) * 2, HashingAlgorithm) If Catch(9) Then HashString = NGHash(StrPtr(vbNullString), Len(str) * 2, HashingAlgorithm) CatchAny eelCritical, "Error hashing string!", ModuleName & ".HashString", True, True diff --git a/Version Control.accda.src/modules/modImportExport.bas b/Version Control.accda.src/modules/modImportExport.bas index 67947757..442f8a9d 100644 --- a/Version Control.accda.src/modules/modImportExport.bas +++ b/Version Control.accda.src/modules/modImportExport.bas @@ -25,7 +25,7 @@ Public Sub ExportSource(blnFullExport As Boolean) Dim lngCount As Long ' Use inline error handling functions to trap and log errors. - On Error Resume Next + If DebugMode Then On Error GoTo 0 Else On Error Resume Next ' Can't export without an open database If CurrentDb Is Nothing And CurrentProject.Connection Is Nothing Then Exit Sub @@ -187,7 +187,7 @@ Public Sub Build(strSourceFolder As String, blnFullBuild As Boolean) Dim strText As String ' Remove later - On Error Resume Next + If DebugMode Then On Error GoTo 0 Else On Error Resume Next ' The type of build will be used in various messages and log entries. strType = IIf(blnFullBuild, "Build", "Merge") diff --git a/Version Control.accda.src/modules/modObjects.bas b/Version Control.accda.src/modules/modObjects.bas index a1ea2d7e..5ce9ac0f 100644 --- a/Version Control.accda.src/modules/modObjects.bas +++ b/Version Control.accda.src/modules/modObjects.bas @@ -93,7 +93,7 @@ End Function '--------------------------------------------------------------------------------------- ' Public Property Get FSO() As Scripting.FileSystemObject - On Error Resume Next + If DebugMode Then On Error GoTo 0 Else On Error Resume Next If m_FSO Is Nothing Then Set m_FSO = New Scripting.FileSystemObject Set FSO = m_FSO CatchAny eelCritical, "Unable to create Scripting.FileSystemObject", ModuleName & ".FSO" @@ -119,4 +119,17 @@ Public Property Get VCSIndex() As clsVCSIndex End Property Public Property Set VCSIndex(cIndex As clsVCSIndex) Set m_VCSIndex = cIndex -End Property \ No newline at end of file +End Property + + +'--------------------------------------------------------------------------------------- +' Procedure : DebugMode +' Author : Adam Waller +' Date : 3/9/2021 +' Purpose : Wrapper for use in error handling. +'--------------------------------------------------------------------------------------- +' +Public Function DebugMode() As Boolean + ' Don't reference the property this till we have loaded the options. + If Not m_Options Is Nothing Then DebugMode = m_Options.BreakOnError +End Function \ No newline at end of file diff --git a/Version Control.accda.src/modules/modSanitize.bas b/Version Control.accda.src/modules/modSanitize.bas index e1b3bb0b..4ab77798 100644 --- a/Version Control.accda.src/modules/modSanitize.bas +++ b/Version Control.accda.src/modules/modSanitize.bas @@ -33,7 +33,7 @@ Public Sub SanitizeFile(strPath As String) Dim sngStartTime As Single Dim strTempFile As String - On Error Resume Next + If DebugMode Then On Error GoTo 0 Else On Error Resume Next ' Read text from file, and split into lines If HasUcs2Bom(strPath) Then