diff --git a/Version Control.accda.src/forms/frmVCSMain.bas b/Version Control.accda.src/forms/frmVCSMain.bas index de354f4c..bdfc5463 100644 --- a/Version Control.accda.src/forms/frmVCSMain.bas +++ b/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 diff --git a/Version Control.accda.src/modules/clsDbModule.cls b/Version Control.accda.src/modules/clsDbModule.cls index e342a840..d1b98c36 100644 --- a/Version Control.accda.src/modules/clsDbModule.cls +++ b/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 diff --git a/Version Control.accda.src/modules/clsDbRelation.cls b/Version Control.accda.src/modules/clsDbRelation.cls index 4d8cd14e..1ecbf3d6 100644 --- a/Version Control.accda.src/modules/clsDbRelation.cls +++ b/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 diff --git a/Version Control.accda.src/modules/clsDbSavedSpec.cls b/Version Control.accda.src/modules/clsDbSavedSpec.cls index 713deb2f..745ad4ae 100644 --- a/Version Control.accda.src/modules/clsDbSavedSpec.cls +++ b/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 diff --git a/Version Control.accda.src/modules/clsDbTableDef.cls b/Version Control.accda.src/modules/clsDbTableDef.cls index c119bee4..963558e6 100644 --- a/Version Control.accda.src/modules/clsDbTableDef.cls +++ b/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) diff --git a/Version Control.accda.src/modules/clsDbVbeProject.cls b/Version Control.accda.src/modules/clsDbVbeProject.cls index df196575..5c2730b4 100644 --- a/Version Control.accda.src/modules/clsDbVbeProject.cls +++ b/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 diff --git a/Version Control.accda.src/modules/clsVCSIndex.cls b/Version Control.accda.src/modules/clsVCSIndex.cls index 396e42e6..ccee4137 100644 --- a/Version Control.accda.src/modules/clsVCSIndex.cls +++ b/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 & _ diff --git a/Version Control.accda.src/modules/clsViewDiff.cls b/Version Control.accda.src/modules/clsViewDiff.cls index 72579031..1d863e02 100644 --- a/Version Control.accda.src/modules/clsViewDiff.cls +++ b/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 diff --git a/Version Control.accda.src/modules/modComAddIn.bas b/Version Control.accda.src/modules/modComAddIn.bas index f1ff74c5..0c801f7d 100644 --- a/Version Control.accda.src/modules/modComAddIn.bas +++ b/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 diff --git a/Version Control.accda.src/modules/modDatabase.bas b/Version Control.accda.src/modules/modDatabase.bas index 35e10d5d..89ed41c7 100644 --- a/Version Control.accda.src/modules/modDatabase.bas +++ b/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 diff --git a/Version Control.accda.src/modules/modFileAccess.bas b/Version Control.accda.src/modules/modFileAccess.bas index a6c68029..754edcd7 100644 --- a/Version Control.accda.src/modules/modFileAccess.bas +++ b/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 diff --git a/Version Control.accda.src/modules/modFunctions.bas b/Version Control.accda.src/modules/modFunctions.bas index a19e3e4a..12bcaeb0 100644 --- a/Version Control.accda.src/modules/modFunctions.bas +++ b/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) diff --git a/Version Control.accda.src/modules/modHash.bas b/Version Control.accda.src/modules/modHash.bas index 6045bc0f..56d2071e 100644 --- a/Version Control.accda.src/modules/modHash.bas +++ b/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 diff --git a/Version Control.accda.src/modules/modImportExport.bas b/Version Control.accda.src/modules/modImportExport.bas index 4e9b0270..f3eb1a4f 100644 --- a/Version Control.accda.src/modules/modImportExport.bas +++ b/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 diff --git a/Version Control.accda.src/modules/modInstall.bas b/Version Control.accda.src/modules/modInstall.bas index 8945635f..31253764 100644 --- a/Version Control.accda.src/modules/modInstall.bas +++ b/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 diff --git a/Version Control.accda.src/modules/modOrphaned.bas b/Version Control.accda.src/modules/modOrphaned.bas index cbad9677..5b04f387 100644 --- a/Version Control.accda.src/modules/modOrphaned.bas +++ b/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 diff --git a/Version Control.accda.src/modules/modUIAutomation.bas b/Version Control.accda.src/modules/modUIAutomation.bas index 6c5990ef..7b07c492 100644 --- a/Version Control.accda.src/modules/modUIAutomation.bas +++ b/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 diff --git a/Version Control.accda.src/modules/modVCSUtility.bas b/Version Control.accda.src/modules/modVCSUtility.bas index 21bf7f7d..8a296512 100644 --- a/Version Control.accda.src/modules/modVCSUtility.bas +++ b/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 diff --git a/Version Control.accda.src/modules/modVbeForm.bas b/Version Control.accda.src/modules/modVbeForm.bas index 44e53636..fbba0dd9 100644 --- a/Version Control.accda.src/modules/modVbeForm.bas +++ b/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 diff --git a/Version Control.accda.src/vcs-options.json b/Version Control.accda.src/vcs-options.json index 7e3f5716..673e5d5c 100644 --- a/Version Control.accda.src/vcs-options.json +++ b/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,