diff --git a/Version Control.accda.src/dbs-properties.json b/Version Control.accda.src/dbs-properties.json index 0f394126..a4853bdb 100644 --- a/Version Control.accda.src/dbs-properties.json +++ b/Version Control.accda.src/dbs-properties.json @@ -41,7 +41,7 @@ "Type": 10 }, "AppVersion": { - "Value": "4.0.24", + "Value": "4.0.25", "Type": 10 }, "Auto Compact": { diff --git a/Version Control.accda.src/forms/frmVCSMain.bas b/Version Control.accda.src/forms/frmVCSMain.bas index 1f90d7b8..08f52751 100644 --- a/Version Control.accda.src/forms/frmVCSMain.bas +++ b/Version Control.accda.src/forms/frmVCSMain.bas @@ -16,10 +16,10 @@ Begin Form Width =9360 DatasheetFontHeight =11 ItemSuffix =33 - Left =3225 - Top =2430 - Right =18945 - Bottom =14175 + Left =20761 + Top =2250 + Right =-29055 + Bottom =13995 OnUnload ="[Event Procedure]" RecSrcDt = Begin 0x79e78b777268e540 @@ -1749,6 +1749,9 @@ Public objSingleObject As AccessObject ' (The Log object has already been reset at this point, so we can't use Log.LogFilePath.) Public strLastLogFilePath As String +' Use this property to set the path to the source files (such as a build triggered from the API) +Public strSourcePath As String + '--------------------------------------------------------------------------------------- ' Procedure : cmdBuild_Click @@ -1760,11 +1763,6 @@ Public strLastLogFilePath As String Public Sub cmdBuild_Click() Dim strFolder As String - Dim strMsg(0 To 2) As String - Dim intChoice As VbMsgBoxResult - - DoCmd.Hourglass True - DoEvents ' Make sure we use the add-in to build the add-in. If CodeProject.FullName = CurrentProject.FullName Then @@ -1774,6 +1772,43 @@ Public Sub cmdBuild_Click() Exit Sub End If + ' Get source files folder + If Len(Me.strSourcePath) Then + ' Use specified build folder + strFolder = Me.strSourcePath + Else + ' Attempt to get the source folder from the current database, or from + ' a folder picker dialog. + strFolder = GetSourceFolder + ' Exit out of build if the user cancelled any of the confirmations. + If strFolder = vbNullString Then Exit Sub + End If + + ' Build project using the selected source folder + ' (Use a timer so we can release the reference to this form before beginning the + ' build process, just in case we need to import a form with the same name.) + If strFolder <> vbNullString Then SetTimer "Build", strFolder, chkFullBuild + +End Sub + + +'--------------------------------------------------------------------------------------- +' Procedure : GetSourceFolder +' Author : Adam Waller +' Date : 10/19/2023 +' Purpose : Return the source files folder from either the currently open database +' : or from a folder picker dialog. (Returns an empty string if the user +' : cancels the selection.) +'--------------------------------------------------------------------------------------- +' +Private Function GetSourceFolder() As String + + Dim strMsg(0 To 2) As String + Dim intChoice As VbMsgBoxResult + + DoCmd.Hourglass True + DoEvents + ' Close the current database if it is currently open. If DatabaseFileOpen Then If FolderHasVcsOptionsFile(Options.GetExportFolder) Then @@ -1795,18 +1830,18 @@ Public Sub cmdBuild_Click() End If If intChoice = vbYes Then ' Rebuild the open project - strFolder = Options.GetExportFolder + GetSourceFolder = Options.GetExportFolder ElseIf intChoice = vbCancel Then ' Canceled out of build option. DoCmd.Hourglass False - Exit Sub + Exit Function End If End If End If ' If we aren't doing the current database, then prompt user to find a folder ' with source files to use for the build. - If strFolder = vbNullString Then + If GetSourceFolder = vbNullString Then ' Show a folder picker to select the file with source code. DoCmd.Hourglass False @@ -1820,26 +1855,21 @@ Public Sub cmdBuild_Click() ' Selected a folder If FolderHasVcsOptionsFile(.SelectedItems(1)) Then ' Has source files - strFolder = .SelectedItems(1) & PathSep + GetSourceFolder = .SelectedItems(1) & PathSep DoCmd.Hourglass True Else MsgBox2 "Source files not found", "Required source files were not found in this folder.", _ "You selected: " & .SelectedItems(1), vbExclamation - Exit Sub + Exit Function End If Else ' Canceled dialog - Exit Sub + Exit Function End If End With End If - ' Build project using the selected source folder - ' (Use a timer so we can release the reference to this form before beginning the - ' build process, just in case we need to import a form with the same name.) - If strFolder <> vbNullString Then SetTimer "Build", strFolder, chkFullBuild - -End Sub +End Function '--------------------------------------------------------------------------------------- diff --git a/Version Control.accda.src/modules/clsVersionControl.cls b/Version Control.accda.src/modules/clsVersionControl.cls index e3c32285..35c22c47 100644 --- a/Version Control.accda.src/modules/clsVersionControl.cls +++ b/Version Control.accda.src/modules/clsVersionControl.cls @@ -118,11 +118,12 @@ End Sub ' Purpose : Initiate a full build from source '--------------------------------------------------------------------------------------- ' -Public Sub Build() +Public Sub Build(Optional strSourceFolder As String) DoCmd.OpenForm "frmVCSMain", , , , , acHidden With Form_frmVCSMain ' Make sure we are doing a full build. If Not .chkFullBuild Then .chkFullBuild = True + .strSourcePath = strSourceFolder .cmdBuild_Click End With End Sub @@ -426,6 +427,7 @@ Public Sub ActivateHook() End If End Sub + '--------------------------------------------------------------------------------------- ' Procedure : Class_Initialize ' Author : Adam Waller diff --git a/Version Control.accda.src/modules/modAPI.bas b/Version Control.accda.src/modules/modAPI.bas index 99daca10..e83c3c34 100644 --- a/Version Control.accda.src/modules/modAPI.bas +++ b/Version Control.accda.src/modules/modAPI.bas @@ -44,7 +44,7 @@ End Enum ' : Access add-in.) '--------------------------------------------------------------------------------------- ' -Public Function HandleRibbonCommand(strCommand As String) As Boolean +Public Function HandleRibbonCommand(strCommand As String, Optional strArgument As String) As Boolean ' The function is called by Application.Run which can be re-entrant but we really ' don't want it to be since that'd cause errors. To avoid this, we will ignore any ' commands while the current command is running. @@ -62,17 +62,21 @@ Public Function HandleRibbonCommand(strCommand As String) As Boolean ' Make sure we are not attempting to run this from the current database when making ' changes to the add-in itself. (It will re-run the command through the add-in.) If RunningOnLocal() Then - RunInAddIn "HandleRibbonCommand", True, strCommand + RunInAddIn "HandleRibbonCommand", True, strCommand, strArgument GoTo CleanUp End If ' If a function is not found, this will throw an error. It is up to the ribbon ' designer to ensure that the control IDs match public procedures in the VCS - ' (clsVersionControl) class module. Additional parameters are not supported. + ' (clsVersionControl) class module. ' For example, to run VCS.Export, the ribbon button ID should be named "btnExport" ' Trim off control ID prefix when calling command - CallByName VCS, Mid(strCommand, 4), VbMethod + If Len(strArgument) Then + CallByName VCS, Mid(strCommand, 4), VbMethod, strArgument + Else + CallByName VCS, Mid(strCommand, 4), VbMethod + End If CleanUp: IsRunning = False @@ -310,7 +314,8 @@ Public Function ExampleBuildFromSource() ' Set the application interaction level to silent to skip confirmation dialogs. Application.Run "MSAccessVCS.SetInteractionMode", 1 ' Launch the build process (as if we clicked the button on the ribbon) - Application.Run "MSAccessVCS.HandleRibbonCommand", "btnBuild" + ' Optionally specify a specific folder of source files to build from. + Application.Run "MSAccessVCS.HandleRibbonCommand", "btnBuild" ', "c:\path\to\source\folder" End If End Function