Fix build path issues with non-relative export folder

Added a new property to save the database build path in the source files. This restores the intended functionality of being able to build from source even when the source folder is in a non-relative location such as another physical drive or network location. Fixes #273

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

@@ -84,7 +84,7 @@ Private Sub IDbComponent_Import(strFile As String)
                     ' Skip these properties
                 Case Else
                     varValue = dItems(varKey)
-                    If Left$(varValue, 4) = "rel:" Then varValue = GetPathFromRelative(CStr(varValue))
+                    If IsRelativePath(CStr(varValue)) Then varValue = GetPathFromRelative(CStr(varValue))
                     If dExisting.Exists(varKey) Then
                         If dItems(varKey) <> dExisting(varKey) Then
                             ' Update value of existing property if different.

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

@@ -95,7 +95,7 @@ Private Sub IDbComponent_Import(strFile As String)
                     If Not TypeOf dItems(varKey)("Value") Is Collection Then
                         varValue = dItems(varKey)("Value")
                         ' Check for relative path
-                        If Left$(varValue, 4) = "rel:" Then varValue = GetPathFromRelative(CStr(varValue))
+                        If IsRelativePath(CStr(varValue)) Then varValue = GetPathFromRelative(CStr(varValue))
                     Else
                         ReDim bArray(0 To dItems(varKey)("Value").Count - 1)
                         For Each varItem In dItems(varKey)("Value")

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

@@ -17,6 +17,7 @@ Option Explicit
 
 Private Const cstrOptionsFilename As String = "vcs-options.json"
 Private Const cstrSourcePathProperty As String = "VCS Source Path"
+Private Const cstrBuildPathProperty As String = "VCS Build Path"
 Private Const ModuleName As String = "clsOptions"
 
 ' Options
@@ -194,6 +195,8 @@ End Sub
 Public Sub SaveOptionsForProject()
     ' Save source path option in current database.
     SavedSourcePath = Me.ExportFolder
+    ' Set the build path, if needed.
+    SetBuildPath
     ' Save options to the export folder location
     Me.SaveOptionsToFile Me.GetExportFolder & cstrOptionsFilename
 End Sub
@@ -245,6 +248,9 @@ Public Sub LoadOptionsFromFile(strFile As String)
         End If
     End If
 
+    ' Set the build path property when loading options
+    SetBuildPath
+
     CatchAny eelError, "Loading options from " & strFile, ModuleName & ".LoadOptionsFromFile"
 
 End Sub
@@ -623,6 +629,44 @@ Private Sub Class_Initialize()
 End Sub
 
 
+'---------------------------------------------------------------------------------------
+' Procedure : SetBuildPath
+' Author    : Adam Waller
+' Date      : 10/28/2021
+' Purpose   : Set a build path property value if the export folder is not relative
+'           : to the current database path.
+'---------------------------------------------------------------------------------------
+'
+Private Sub SetBuildPath()
+
+    Dim prp As AccessObjectProperty
+    Dim proj As CurrentProject
+
+    Set proj = CurrentProject
+    Set prp = GetPropertyByName(cstrBuildPathProperty)
+
+    ' This should only be done on an open database/project
+    If DatabaseFileOpen Then
+        ' Check the export folder option
+        If Me.ExportFolder = vbNullString Then
+            ' When using the default of a blank export path, we don't need
+            ' to store the build folder location. (It will be different on
+            ' different computers, and not needed for a relative export path.)
+            If Not prp Is Nothing Then proj.Properties.Remove prp.Name
+        Else
+            If prp Is Nothing Then
+                ' Create the property
+                proj.Properties.Add cstrBuildPathProperty, proj.Path
+            Else
+                ' Update the value.
+                If prp.Value <> proj.Path Then prp.Value = proj.Path
+            End If
+        End If
+    End If
+
+End Sub
+
+
 '---------------------------------------------------------------------------------------
 ' Procedure : SavedSourcePath
 ' Author    : Adam Waller
@@ -634,7 +678,7 @@ End Sub
 '
 Private Property Get SavedSourcePath() As String
     Dim prp As AccessObjectProperty
-    Set prp = GetSavedSourcePathProperty
+    Set prp = GetPropertyByName(cstrSourcePathProperty)
     If Not prp Is Nothing Then SavedSourcePath = prp.Value
 End Property
 
@@ -652,7 +696,7 @@ Private Property Let SavedSourcePath(strPath As String)
     Dim proj As CurrentProject
 
     Set proj = CurrentProject
-    Set prp = GetSavedSourcePathProperty
+    Set prp = GetPropertyByName(cstrSourcePathProperty)
 
     If strPath = vbNullString Then
         ' Remove the property when no longer used.
@@ -671,21 +715,27 @@ End Property
 
 
 '---------------------------------------------------------------------------------------
-' Procedure : GetSavedSourcePathProperty
+' Procedure : GetPropertyByName
 ' Author    : Adam Waller
-' Date      : 7/14/2020
-' Purpose   : Helper function to get
+' Date      : 10/28/2021
+' Purpose   : Return a project property
 '---------------------------------------------------------------------------------------
 '
-Private Function GetSavedSourcePathProperty() As AccessObjectProperty
+Private Function GetPropertyByName(strName As String) As AccessObjectProperty
+
     Dim prp As AccessObjectProperty
+    Dim proj As CurrentProject
+
     If DatabaseFileOpen Then
-        For Each prp In CurrentProject.Properties
-            If prp.Name = cstrSourcePathProperty Then
-                Set GetSavedSourcePathProperty = prp
+        Set proj = CurrentProject
+        For Each prp In proj.Properties
+            If prp.Name = strName Then
+                Set GetPropertyByName = prp
                 Exit For
             End If
         Next prp
     End If
+
 End Function
 
+

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

@@ -461,7 +461,7 @@ End Function
 '---------------------------------------------------------------------------------------
 '
 Public Function GetPathFromRelative(strPath As String) As String
-    If Left$(strPath, 4) = "rel:" Then
+    If IsRelativePath(strPath) Then
         GetPathFromRelative = FSO.BuildPath(CurrentProject.Path, Mid$(strPath, 5))
     Else
         ' No relative path used.
@@ -470,6 +470,18 @@ Public Function GetPathFromRelative(strPath As String) As String
 End Function
 
 
+'---------------------------------------------------------------------------------------
+' Procedure : IsRelativePath
+' Author    : Adam Waller
+' Date      : 10/29/2021
+' Purpose   : Returns true if the specified path is stored as relative.
+'---------------------------------------------------------------------------------------
+'
+Public Function IsRelativePath(strPath As String) As Boolean
+    IsRelativePath = (Left$(strPath, 4) = "rel:")
+End Function
+
+
 '---------------------------------------------------------------------------------------
 ' Procedure : GetUncPath
 ' Author    : Adam Waller

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

@@ -370,9 +370,15 @@ Public Function GetOriginalDbFullPathFromSource(strFolder As String) As String
             ' Check to see if we are using an absolute export path  (\\* or *:*)
             If StartsWith(Options.ExportFolder, PathSep & PathSep) _
                 Or (InStr(2, Options.ExportFolder, ":") > 0) Then
-                ' We don't save the absolute path in source code, so the user
-                ' needs to determine the file location.
-                Exit Function
+                ' Look for saved build path
+                Set dContents = ReadJsonFile(FSO.BuildPath(strFolder, "proj-properties.json"))
+                strPath = dNZ(dContents, "Items\VCS Build Path")
+                If strPath <> vbNullString Then
+                    GetOriginalDbFullPathFromSource = strPath & PathSep & strFile
+                Else
+                    ' Unable to determine the original file location.
+                    Exit Function
+                End If
             Else
                 ' Calculate how many levels deep to create original path
                 lngLevel = UBound(Split(StripSlash(Options.ExportFolder), PathSep))