Form_Accessions, cAccnScan / bulk adding images, allow use of path in…

…formation in CabinetFolders table to determine destination path without having to navigate a file picker.

Form_Accessions.cls

@@ -97,7 +97,10 @@ Private Sub cmdAddScan_Click()
 
             If Not oAccnScan.isOnDefaultDrive Then
                 If Len(sDestinationFolder) = 0 Then
+                    Let sDestinationFolder = oAccnScan.FolderHomePath
+                End If
 
+                If Len(sDestinationFolder) = 0 Then
                     Set dlgDestinationFolder = Application.FileDialog(msoFileDialogFolderPicker): With dlgDestinationFolder
                         .Title = "Destination Folder"
                     End With
@@ -106,7 +109,7 @@ Private Sub cmdAddScan_Click()
                         Let sDestinationFolder = dlgDestinationFolder.SelectedItems(1)
                     End If
                 End If
-
+                                
                 If Len(sDestinationFolder) > 0 Then
                     oAccnScan.doCopyTo NewPath:=sDestinationFolder
                     Let sItem = oAccnScan.Url

cAccession.cls

@@ -85,6 +85,9 @@ Public Property Let Major(s As String)
 
     If canUseForMajor(s) Then
         Let iMajor = CLng(s)
+        If iMajor < 1900 And Len(s) = 2 Then
+            Let iMajor = 1900 + iMajor
+        End If
         Let sMajor = Format(iMajor, MajorFormat)
     Else
         Let sMajor = ""
@@ -197,7 +200,7 @@ Private Sub RetrieveAttachmentsFromDB()
 
     Dim Rs As DAO.Recordset
     Dim oQuery As DAO.QueryDef
-    Dim i As Integer, iCount As Integer
+    Dim I As Integer, iCount As Integer
 
     'check the database for comments flagged with this CollectionNumber
     On Error Resume Next: CurrentDb.QueryDefs.Delete "qScanFilesByAccn": On Error GoTo 0

cAccnScan.cls

@@ -106,17 +106,27 @@ End Function
 Public Property Let Url(sUrl As String)
     Dim aPath() As String
     Dim sPath As String
+    Dim iStartPath As Integer
     Dim I As Integer
 
     aPath = Split(sUrl, "\")
     FileName = aPath(UBound(aPath))
 
     sDrive = ""
     sPath = ""
-    For I = LBound(aPath) To UBound(aPath) - 1
-        If Right(aPath(I), 1) = ":" Then
-            sDrive = aPath(I)
-        ElseIf Len(aPath(I)) = 0 Then
+
+    Let iStartPath = LBound(aPath)
+
+    If RegexMatch(Left(sUrl, 2), "[A-Za-z][:]") Then
+        Let sDrive = Left(sUrl, 2)
+        Let iStartPath = iStartPath + 1
+    ElseIf Left(sUrl, 2) = "\\" Or Left(sUrl, 2) = "//" Then
+        Let sDrive = "\\" & aPath(iStartPath + 2) & "\" & aPath(iStartPath + 3)
+        Let iStartPath = iStartPath + 4
+    End If
+
+    For I = iStartPath To UBound(aPath) - 1
+        If Len(aPath(I)) = 0 Then
             'NOOP
         ElseIf (Len(sDrive) = 0) And (aPath(I) = PathStart) Then
             sDrive = "\" & sPath
@@ -265,27 +275,6 @@ Public Function AccnDate() As Date
     End If
 End Function
 
-Public Sub ForceCorrectFileName()
-    Dim sAccnYear As String
-    Dim sAccnPoint As String
-    Dim sAccnDate As String
-    Dim oRefs As Variant
-
-    Set oRefs = MetadataFromFileName
-
-    sAccnDate = oRefs(3) & oRefs(4) & oRefs(5)
-
-    If Val(oRefs(1)) < 1900 Then
-        sAccnYear = Format(1900 + Val(oRefs(1)), "0000")
-    Else
-        sAccnYear = Format(Val(oRefs(1)), "0000")
-    End If
-
-    sAccnPoint = Format(Val(oRefs(2)), "0000")
-
-    Let sFileNameCorrected = oRefs(0) & "_" & sAccnYear & "_" & sAccnPoint & "_" & sAccnDate & oRefs(6) & ".PDF"
-End Sub
-
 Public Sub InsertIntoAccessions(Optional ByVal OnCurrent As Boolean, Optional ByVal NewRecord As Boolean, Optional ByRef ListView As Variant)
     Dim sSuggestion As String
     Dim rsAccnScan As DAO.Recordset
@@ -410,6 +399,27 @@ Public Sub InsertIntoAccessions(Optional ByVal OnCurrent As Boolean, Optional By
 
 End Sub
 
+Public Sub ForceCorrectFileName()
+    Dim sAccnYear As String
+    Dim sAccnPoint As String
+    Dim sAccnDate As String
+    Dim oRefs As Variant
+
+    Set oRefs = MetadataFromFileName
+
+    sAccnDate = oRefs(3) & oRefs(4) & oRefs(5)
+
+    If Val(oRefs(1)) < 1900 Then
+        sAccnYear = Format(1900 + Val(oRefs(1)), "0000")
+    Else
+        sAccnYear = Format(Val(oRefs(1)), "0000")
+    End If
+
+    sAccnPoint = Format(Val(oRefs(2)), "0000")
+
+    Let sFileNameCorrected = oRefs(0) & "_" & sAccnYear & "_" & sAccnPoint & "_" & sAccnDate & oRefs(6) & ".PDF"
+End Sub
+
 Public Sub ConvertFileName(ByRef Result As String)
     Dim oIsOldAccnFile As New RegExp
     Dim reIsCopierScan As New RegExp
@@ -501,6 +511,19 @@ Public Function isOnDefaultDrive() As Boolean
     Let isOnDefaultDrive = (driveNames(1) = driveNames(2))
 End Function
 
+Public Function FolderHomePath()
+    Dim oFolder As cCabinetFolder
+
+    Set oFolder = New cCabinetFolder: With oFolder
+    .FileSourcePath = FileFolderSlug
+    End With
+
+    If oFolder.ID <> 0 Then
+        Let FolderHomePath = getDefaultDrive & oFolder.FolderPath
+    End If
+
+End Function
+
 Public Sub doCopyTo(NewPath As String)
     Dim sOldFullPath As String
     Dim sNewFullPath As String