Update error handling

Refactored a number of locations to use the new syntax for On Error Resume Next, and added code to clear expected errors.

Version Control.accda.src/forms/frmVCSMain.bas

@@ -1965,7 +1965,8 @@ End Sub
 '
 Private Sub cmdClose_Click()
     ' Ignore the error if the user resumes (cancels the close operation)
-    If DebugMode(True) Then On Error Resume Next Else On Error Resume Next
+    LogUnhandledErrors
+    On Error Resume Next
     DoCmd.Close acForm, Me.Name
     Catch 2501  ' Close form was canceled.
 End Sub

Version Control.accda.src/modules/clsDbModule.cls

@@ -95,7 +95,8 @@ Private Sub IDbComponent_Import(strFile As String)
     DoCmd.Save acModule, strName
 
     ' Set reference to object
-    If DebugMode(True) Then On Error Resume Next Else On Error Resume Next
+    LogUnhandledErrors
+    On Error Resume Next
     Set m_Module = CurrentProject.AllModules(strName)
     If Catch(2467) Then Log.Error eelCritical, _
         "Imported module not found after import: " & strName, ModuleName(Me) & ".Import"
@@ -205,7 +206,8 @@ Private Sub LoadVbeModuleFromFile(strFile As String, strName As String)
     With proj.VBComponents
 
         ' Remove any existing component (In most cases the module will exist)
-        If DebugMode(True) Then On Error Resume Next Else On Error Resume Next
+        LogUnhandledErrors
+        On Error Resume Next
         .Remove .Item(strName)
         If DebugMode(False) Then On Error GoTo 0 Else On Error Resume Next
 

Version Control.accda.src/modules/clsDbRelation.cls

@@ -95,7 +95,8 @@ Private Sub IDbComponent_Import(strFile As String)
         ' Relationships create indexes, so we need to make sure an index
         ' with this name doesn't already exist. (Also check to be sure that
         ' we don't already have a relationship with this name.)
-        If DebugMode(True) Then On Error Resume Next Else On Error Resume Next
+        LogUnhandledErrors
+        On Error Resume Next
         With m_Dbs
             .TableDefs(rel.Table).Indexes.Delete rel.Name
             .TableDefs(rel.ForeignTable).Indexes.Delete rel.Name
@@ -134,6 +135,7 @@ Private Sub IDbComponent_Merge(strFile As String)
         On Error Resume Next
         CurrentDb.Relations.Delete FSO.GetBaseName(strFile)
         VCSIndex.Remove Me, strFile
+        If Err Then Err.Clear
     End If
 End Sub
 

Version Control.accda.src/modules/clsDbSavedSpec.cls

@@ -179,7 +179,8 @@ Private Function GetDictionary() As Dictionary
 
     Set dSpec = New Dictionary
 
-    If DebugMode(True) Then On Error Resume Next Else On Error Resume Next
+    LogUnhandledErrors
+    On Error Resume Next
     ' For some reason it throws an error if there is no
     ' description in the specification.
     With dSpec

Version Control.accda.src/modules/clsDbTableDef.cls

@@ -518,7 +518,8 @@ Private Function IndexAvailable(tdf As TableDef) As Boolean
 
     Dim lngTest As Long
 
-    If DebugMode(True) Then On Error Resume Next Else On Error Resume Next
+    LogUnhandledErrors
+    On Error Resume Next
     lngTest = tdf.Indexes.Count
     If Err Then
         Err.Clear
@@ -547,7 +548,8 @@ Private Function ImportLinkedTable(strFile As String) As Boolean
     Dim strSql As String
     Dim strConnect As String
 
-    If DebugMode(True) Then On Error Resume Next Else On Error Resume Next
+    LogUnhandledErrors
+    On Error Resume Next
 
     ' Read json file
     Set dTable = ReadJsonFile(strFile)

Version Control.accda.src/modules/clsDbVbeProject.cls

@@ -108,7 +108,8 @@ Private Sub SafeSetProperty(cProj As VBProject, strProperty As String, varValue
     If varValue = varCurrent Then Exit Sub
 
     ' Switch to on error resume next after checking for current errors
-    If DebugMode(True) Then On Error Resume Next Else On Error Resume Next
+    LogUnhandledErrors
+    On Error Resume Next
 
     ' Attempt to set the property
     CallByName cProj, strProperty, VbLet, varValue

Version Control.accda.src/modules/clsVCSIndex.cls

@@ -776,7 +776,8 @@ End Property
 Public Sub ClearTempExportFolder()
     If m_strTempExportFolderPath <> vbNullString Then
         If FSO.FolderExists(m_strTempExportFolderPath) Then
-            If DebugMode(True) Then On Error Resume Next Else On Error Resume Next
+            LogUnhandledErrors
+            On Error Resume Next
             ' Use FSO to delete the folder and contents
             FSO.DeleteFolder m_strTempExportFolderPath, True
             CatchAny eelWarning, "Unable to delete temp folder: '" & m_strTempExportFolderPath & _

Version Control.accda.src/modules/clsViewDiff.cls

@@ -140,7 +140,8 @@ Public Sub ClearTempFiles()
     Dim varFile As Variant
 
     If Not m_colTempFiles Is Nothing Then
-        If DebugMode(True) Then On Error Resume Next Else On Error Resume Next
+        LogUnhandledErrors
+        On Error Resume Next
         For Each varFile In m_colTempFiles
             If FSO.FileExists(varFile) Then DeleteFile CStr(varFile)
         Next varFile
@@ -185,7 +186,8 @@ Private Sub RunCompare(strFile1 As String, strFile2 As String)
     End Select
 
     ' Run command to launch compare
-    If DebugMode(True) Then On Error Resume Next Else On Error Resume Next
+    LogUnhandledErrors
+    On Error Resume Next
     If strCmd <> vbNullString Then
         With New WshShell
             .Run strCmd

Version Control.accda.src/modules/modComAddIn.bas

@@ -306,7 +306,8 @@ Private Function DllIsRegistered() As Boolean
     ' Check HKLM registry key
     With New IWshRuntimeLibrary.WshShell
         ' We should have a value here if the install ran in the past.
-        If DebugMode(True) Then On Error Resume Next Else On Error Resume Next
+        LogUnhandledErrors
+        On Error Resume Next
         ' Look up the class ID from the COM registration
         strTest = .RegRead("HKCU\SOFTWARE\Classes\MSAccessVCSLib.AddInRibbon\CLSID\")
         If strTest <> vbNullString Then
@@ -318,6 +319,7 @@ Private Function DllIsRegistered() As Boolean
                 DllIsRegistered = FSO.FileExists(strTest)
             End If
         End If
+        If Err Then Err.Clear
     End With
 
 End Function

Version Control.accda.src/modules/modDatabase.bas

@@ -392,9 +392,11 @@ Public Function ObjectExists(intType As AcObjectType, strName As String, Optiona
         Log.Error eelError, "Parent container not supported for this object type: " & intType, ModuleName & ".ObjectExists"
     Else
         ' Attempt to reference the object by name
-        If DebugMode(True) Then On Error Resume Next Else On Error Resume Next
+        LogUnhandledErrors
+        On Error Resume Next
         Set objTest = objContainer(strName)
         ObjectExists = Not Catch(2467)
+        If Err Then Err.Clear
     End If
 
 End Function
@@ -573,7 +575,8 @@ Public Function DatabaseFileOpen() As Boolean
     Else
         ' For ADP projects, CurrentProject may be an invalid object reference
         ' after the database file (adp) is closed.
-        If DebugMode(True) Then On Error Resume Next Else On Error Resume Next
+        LogUnhandledErrors
+        On Error Resume Next
         strTest = CurrentProject.FullName
         CatchAny eelNoError, vbNullString
         DatabaseFileOpen = (strTest <> vbNullString)
@@ -637,7 +640,8 @@ Public Function DeleteObjectIfExists(intType As AcObjectType, strName As String)
     End Select
 
     ' Trap errors when attempting to delete the object
-    If DebugMode(True) Then On Error Resume Next Else On Error Resume Next
+    LogUnhandledErrors
+    On Error Resume Next
 
     If Not blnExistsInAddIn Then
         ' Nice! We can use a simple call to delete the object
@@ -718,10 +722,12 @@ Public Function FormLoaded(frmMe As Form) As Boolean
     ' If no forms are open, we already have our answer.  :-)
     If Forms.Count > 0 Then
         ' We will throw an error accessing the name property if the form is closed
-        If DebugMode(True) Then On Error Resume Next Else On Error Resume Next
+        LogUnhandledErrors
+        On Error Resume Next
         strName = frmMe.Name
         ' Return true if we were able to read the name property
         FormLoaded = strName <> vbNullString
+        If Err Then Err.Clear
     End If
 End Function
 
@@ -747,7 +753,8 @@ Public Function VerifyFocus(ctlWithFocus As Control) As Boolean
     Set frmParent = objParent
 
     ' Ignore any errors with Screen.* functions
-    If DebugMode(True) Then On Error Resume Next Else On Error Resume Next
+    LogUnhandledErrors
+    On Error Resume Next
 
     ' Verify focus of parent form
     Set frmParent = Screen.ActiveForm

Version Control.accda.src/modules/modFileAccess.bas

@@ -138,7 +138,8 @@ Public Sub WriteFile(strText As String, strPath As String, Optional strEncoding
         ' Write to disk
         VerifyPath strPath
         ' Watch out for possible write error
-        If DebugMode(True) Then On Error Resume Next Else On Error Resume Next
+        LogUnhandledErrors
+        On Error Resume Next
         .SaveToFile strPath, adSaveCreateOverWrite
         If Catch(3004) Then
             ' File is locked. Try again after 1 second, just in case something

Version Control.accda.src/modules/modFunctions.bas

@@ -789,6 +789,9 @@ Public Function IsEmptyArray(varArray As Variant) As Boolean
     lngLowBound = clngTest
     lngLowBound = LBound(varArray)
 
+    ' Clear any error thrown while attempting to read LBound()
+    If Err Then Err.Clear
+
     ' If the above assignment fails, we have an empty array
     IsEmptyArray = (lngLowBound = clngTest)
 

Version Control.accda.src/modules/modHash.bas

@@ -132,14 +132,16 @@ End Function
 '---------------------------------------------------------------------------------------
 '
 Private Function HashBytes(Data() As Byte, Optional HashingAlgorithm As String = DefaultHashAlgorithm) As Byte()
-    If DebugMode(True) Then On Error Resume Next Else On Error Resume Next
+    LogUnhandledErrors
+    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 = DefaultHashAlgorithm) As Byte()
-    If DebugMode(True) Then On Error Resume Next Else On Error Resume Next
+    LogUnhandledErrors
+    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
@@ -274,7 +276,8 @@ Public Function GetCodeModuleHash(intType As eDatabaseComponentType, strName As
         Set proj = CurrentVBProject
 
         ' Attempt to locate the object in the VBComponents collection
-        If DebugMode(True) Then On Error Resume Next Else On Error Resume Next
+        LogUnhandledErrors
+        On Error Resume Next
         Set cmpItem = proj.VBComponents(strPrefix & strName)
         Catch 9 ' Component not found. (Could be an object with no code module)
         CatchAny eelError, "Error accessing VBComponent for '" & strPrefix & strName & "'", ModuleName & ".GetCodeModuleHash"
@@ -383,4 +386,7 @@ Public Function GetSimpleHash(strText As String) As String
     ' Return short hash
     GetSimpleHash = Left(strHash, 7)
 
+    ' Clear any errors
+    If Err Then Err.Clear
+
 End Function

Version Control.accda.src/modules/modImportExport.bas

@@ -1489,7 +1489,8 @@ Public Sub InitializeForms(cContainers As Dictionary)
     Dim varKey As Variant
 
     ' Trap any errors that may occur when opening forms
-    If DebugMode(True) Then On Error Resume Next Else On Error Resume Next
+    LogUnhandledErrors
+    On Error Resume Next
 
     ' See if we imported any forms
     For Each cont In cContainers

Version Control.accda.src/modules/modInstall.bas

@@ -439,7 +439,8 @@ Private Sub RemoveMenuItem(ByVal strName As String, Optional Hive As eHive = ehH
     strPath = GetAddinRegPath(Hive) & strName & "\"
     With New IWshRuntimeLibrary.WshShell
         ' Just in case someone changed some of the keys...
-        If DebugMode(True) Then On Error Resume Next Else On Error Resume Next
+        LogUnhandledErrors
+        On Error Resume Next
         .RegDelete strPath & "Expression"
         .RegDelete strPath & "Library"
         .RegDelete strPath & "Version"
@@ -552,7 +553,8 @@ Private Sub RunUpgrades()
         ' Check for installation in HKLM hive.
         strOldPath = GetAddinRegPath(ehHKLM) & "&Version Control\Library"
         Set objShell = New IWshRuntimeLibrary.WshShell
-        If DebugMode(True) Then On Error Resume Next Else On Error Resume Next
+        LogUnhandledErrors
+        On Error Resume Next
         strTest = objShell.RegRead(strOldPath)
         If Err Then Err.Clear
         On Error GoTo 0
@@ -634,7 +636,8 @@ End Sub
 Public Function HasLegacyRC4Keys()
     Dim strValue As String
     With New IWshRuntimeLibrary.WshShell
-        If DebugMode(True) Then On Error Resume Next Else On Error Resume Next
+        LogUnhandledErrors
+        On Error Resume Next
         strValue = .RegRead("HKCU\SOFTWARE\VB and VBA Program Settings\MSAccessVCS\Private Keys\")
         HasLegacyRC4Keys = Not Catch(-2147024894)
         CatchAny eelError, "Checking for legacy RC4 keys", ModuleName & ".HasLegacyRC4Keys"
@@ -797,7 +800,8 @@ Public Sub RemoveTrustedLocation(Optional strName As String)
     strPath = GetTrustedLocationRegPath(strName)
 
     With New IWshRuntimeLibrary.WshShell
-        If DebugMode(True) Then On Error Resume Next Else On Error Resume Next
+        LogUnhandledErrors
+        On Error Resume Next
         .RegDelete strPath & "Path"
         .RegDelete strPath & "Date"
         .RegDelete strPath & "Description"
@@ -998,6 +1002,8 @@ Private Function CheckRegKey(strPath As String, ParamArray AllowedValues() As Va
         End If
     Next intCnt
 
+    If Err Then Err.Clear
+
 End Function
 
 

Version Control.accda.src/modules/modOrphaned.bas

@@ -279,4 +279,7 @@ Public Sub RemoveOrphanedDatabaseObjects(cCategory As IDbComponent)
         End If
     Next varKey
 
+    ' Handle any uncaught errors
+    CatchAny eelError, "Error removing orphaned objects.", ModuleName & ".RemoveOrphanedDatabaseObjects"
+
 End Sub

Version Control.accda.src/modules/modUIAutomation.bas

@@ -73,7 +73,8 @@ Private Function GetUnderlyingDbObjectFromButton(oClient As CUIAutomation, oElem
     strImage = GetImageName(oClient, oElement)
 
     ' Just in case something doesn't work right...
-    If DebugMode(True) Then On Error Resume Next Else On Error Resume Next
+    LogUnhandledErrors
+    On Error Resume Next
 
     ' There are multiple icons for some objects
     If LikeAny(strImage, "Table*", "*Tabelle") Then

Version Control.accda.src/modules/modVCSUtility.bas

@@ -923,8 +923,10 @@ End Function
 Public Sub LoadVCSAddIn()
     ' The following lines will load the add-in at the application level,
     ' but will not actually call the function. Ignore the error of function not found.
-    If DebugMode(True) Then On Error Resume Next Else On Error Resume Next
+    LogUnhandledErrors
+    On Error Resume Next
     Application.Run GetAddInFileName & "!DummyFunction"
+    If Err Then Err.Clear
 End Sub
 
 

Version Control.accda.src/modules/modVbeForm.bas

@@ -144,6 +144,7 @@ Private Sub AddProperty(dic As Dictionary, o As Object, strName As Variant)
             ' Use CallByName on object to get value if the property exists
             On Error Resume Next
             dic.Add strName, CallByName(o, strName, VbGet)
+            If Err Then Err.Clear
     End Select
 End Sub
 

Version Control.accda.src/vcs-options.json

@@ -1,6 +1,6 @@
 {
   "Info": {
-    "AddinVersion": "4.0.22",
+    "AddinVersion": "4.0.26",
     "AccessVersion": "14.0 32-bit"
   },
   "Options": {
@@ -36,6 +36,7 @@
     "FormatSQL": true,
     "ForceImportOriginalQuerySQL": false,
     "SaveTableSQL": true,
+    "SplitLayoutFromVBA": false,
     "StripPublishOption": true,
     "SanitizeColors": 3,
     "SanitizeLevel": 2,