From 7fc0e274893763e26fbc22e34acf9f0bae101bf8 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Josef=20P=C3=B6tzl?= <josef.poetzl@joposol.at>
Date: Sat, 11 May 2024 22:25:39 +0200
Subject: [PATCH] minor changes for run-add-in-proc feature

---
 .../modules/clsVersionControl.cls             | 45 +++++++++++--------
 .../modules/modImportExport.bas               |  7 +--
 Version Control.accda.src/vcs-options.json    |  2 +-
 3 files changed, 32 insertions(+), 22 deletions(-)

diff --git a/Version Control.accda.src/modules/clsVersionControl.cls b/Version Control.accda.src/modules/clsVersionControl.cls
index 8fe8accc..3b58ce7c 100644
--- a/Version Control.accda.src/modules/clsVersionControl.cls	
+++ b/Version Control.accda.src/modules/clsVersionControl.cls	
@@ -53,10 +53,13 @@ End Sub
 ' Purpose   : Export the source code for the current database
 '---------------------------------------------------------------------------------------
 '
-Public Sub Export()
-    If HasFormOpen Then Exit Sub
-    RunExport ecfAllObjects
-End Sub
+Public Function Export() As eErrorLevel
+    If HasFormOpen Then
+        Export = eelCritical
+        Exit Function
+    End If
+    Export = RunExport(ecfAllObjects)
+End Function
 
 
 '---------------------------------------------------------------------------------------
@@ -66,10 +69,13 @@ End Sub
 ' Purpose   : Export just the VBA related components
 '---------------------------------------------------------------------------------------
 '
-Public Sub ExportVBA()
-    If HasFormOpen Then Exit Sub
-    RunExport ecfVBAItems
-End Sub
+Public Function ExportVBA() As eErrorLevel
+    If HasFormOpen Then
+        ExportVBA = eelCritical
+        Exit Function
+    End If
+    ExportVBA = RunExport(ecfVBAItems)
+End Function
 
 
 '---------------------------------------------------------------------------------------
@@ -79,24 +85,27 @@ End Sub
 ' Purpose   : Export the selected object
 '---------------------------------------------------------------------------------------
 '
-Public Sub ExportSelected()
+Public Function ExportSelected() As eErrorLevel
 
     Dim objSelected As AccessObject
 
-    If HasFormOpen Then Exit Sub
+    If HasFormOpen Then
+        ExportSelected = eelCritical
+        Exit Function
+    End If
 
     Set objSelected = GetSelectedNavPaneObject
     If objSelected Is Nothing Then
+        ExportSelected = eelCritical
         MsgBox2 "Please Select an Object First", _
             "Select a single object in the Navigation Pane to export.", _
             "(This item must have the keyboard focus.)", vbInformation
-        ExportSelected = eelCritical
     Else
         ' Export the item
         ExportSelected = RunExport(, objSelected)
     End If
 
-End Sub
+End Function
 
 
 '---------------------------------------------------------------------------------------
@@ -106,7 +115,8 @@ End Sub
 ' Purpose   : Handle different kinds of exports based on filter
 '---------------------------------------------------------------------------------------
 '
-Private Function RunExport(Optional intFilter As eContainerFilter = ecfAllObjects, Optional objItem As AccessObject) As eErrorLevel
+Private Function RunExport(Optional intFilter As eContainerFilter = ecfAllObjects, _
+                           Optional objItem As AccessObject) As eErrorLevel
 
     Dim ExportErrorLevel As eErrorLevel
 
@@ -133,7 +143,6 @@ Private Function RunExport(Optional intFilter As eContainerFilter = ecfAllObject
 
 End Function
 
-
 '---------------------------------------------------------------------------------------
 ' Procedure : Build
 ' Author    : Adam Waller
@@ -523,9 +532,9 @@ Private Sub SaveState()
 
     ' Error trapping setting. (We need this to "Break in Class Modules" for this add-in)
     strValue = Application.GetOption("Error Trapping")
-    If strValue <> "2" Then
+    If strValue < "1" Then
         PreserveSetting "Error Trapping", strValue
-        Application.SetOption "Error Trapping", 2
+        Application.SetOption "Error Trapping", 1
     End If
 
 End Sub
@@ -646,9 +655,9 @@ Private Function HasFormOpen(Optional blnWarnUser As Boolean = True) As Boolean
                     End If
                     MsgBox2 "Add-in Form Already Open", _
                         "Please close '" & strCaption & "' before running this action.", , vbInformation
-                    HasFormOpen = True
-                    Exit Function
                 End If
+                HasFormOpen = True
+                Exit Function
             End If
         End If
     Next
diff --git a/Version Control.accda.src/modules/modImportExport.bas b/Version Control.accda.src/modules/modImportExport.bas
index 552cd103..bcbaa693 100644
--- a/Version Control.accda.src/modules/modImportExport.bas	
+++ b/Version Control.accda.src/modules/modImportExport.bas	
@@ -294,10 +294,11 @@ Private Function TryRunAddInProcedure(ByVal ProcedureName As String) As Boolean
 
 If DebugMode(True) Then On Error GoTo 0 Else On Error GoTo ErrHandler
 
-    ProcedureName = Replace(ProcedureName, "%appdata%", Environ("appdata"))
+    ProcedureName = Replace(ProcedureName, "%addins%", Environ$("appdata") & "\Microsoft\AddIns")
+    ProcedureName = Replace(ProcedureName, "%appdata%", Environ$("appdata"))
 
-    AddInFile = Left(ProcedureName, InStrRev(ProcedureName, ".")) & "accda"
-    If Len(VBA.Dir(AddInFile)) = 0 Then
+    AddInFile = Left$(ProcedureName, InStrRev(ProcedureName, ".")) & "accda"
+    If Len(Dir(AddInFile)) = 0 Then
         Exit Function ' or raise error?
     End If
 
diff --git a/Version Control.accda.src/vcs-options.json b/Version Control.accda.src/vcs-options.json
index 89fbd172..212fafd4 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.35-x",
+    "AddinVersion": "4.0.36-jp",
     "AccessVersion": "14.0 32-bit"
   },
   "Options": {