Permalink
Browse files

Form_CabinetFolders / dialog file pickers and the like to add cabinet…

… folder records
  • Loading branch information...
C. Johnson
C. Johnson committed May 8, 2018
1 parent 791f309 commit 4d43b032eaa4e9bc49d5e2c0de6b93725c56dbe4
Showing with 75 additions and 0 deletions.
  1. +59 −0 Form_CabinetFolders.cls
  2. +16 −0 ModControlFilesDatabase.bas
View
@@ -0,0 +1,59 @@
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "Form_CabinetFolders"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Compare Database
Option Explicit
Private Sub cmdFilePathPicker_Click()
Dim sDestinationFolder As String
'Get a path
Let sDestinationFolder = DestinationFolderDialog
'Take the slug from the end
Let FilePath.Value = FileFolderSlug(sDestinationFolder)
End Sub
Private Sub cmdFileSourcePathPicker_Click()
Dim sDestinationFolder As String
'Get a path
Let sDestinationFolder = DestinationFolderDialog
'Take the slug from the end
Let FileSourcePath.Value = FileFolderSlug(sDestinationFolder)
End Sub
Private Sub cmdFolderPathPicker_Click()
Dim sDestinationFolder As String
Dim NamingConvention As New CScanFileNamingConvention
'Get a path
Let sDestinationFolder = DestinationFolderDialog
'Feed a hypothetical scan file name into NamingConvention
If Len(Dir(sDestinationFolder & "\ControlFile\.")) > 0 Then
Let sDestinationFolder = sDestinationFolder & "\ControlFile"
ElseIf Len(Dir(sDestinationFolder & "\ControlFiles\.")) > 0 Then
Let sDestinationFolder = sDestinationFolder & "\ControlFiles"
End If
Let NamingConvention.Url = sDestinationFolder & "\copier.pdf"
Let FolderPath.Value = NamingConvention.RelativePath
End Sub
Private Sub cmdSign_Click()
If Len(Nz(AddedToDatabaseBy.Value)) = 0 Then
Let AddedToDatabaseBy.Value = getUserName
End If
Let AddedToDatabaseOn.Value = Now
End Sub
@@ -968,6 +968,22 @@ Public Function DestinationFolderDialog() As String
End Function
Public Function FileFolderSlug(Path As String) As String
Dim Last As Integer
Dim aPath() As String
Let aPath = Split(Path, "\"): Let Last = UBound(aPath)
If Last >= LBound(aPath) Then
If RegexMatch(aPath(Last), "^Contr?olFiles?$") Then
Let Last = Last - 1
End If
End If
If Last >= LBound(aPath) Then
Let FileFolderSlug = aPath(Last)
End If
End Function
Public Sub InitializePipesAndFilters()
If gPipes Is Nothing Then
Set gPipes = New cPipeNetwork

0 comments on commit 4d43b03

Please sign in to comment.