Open file dialog to specific folder (1 Viewer)

Local time
Today, 05:15
Joined
Dec 10, 2024
Messages
77
Hi,
When a new record is created, my form uses the after insert event to create a folder with the customer name, and inside this the job number

Folder structure is M:\Job Photos\CustomerName\M12345\

Inside this folder I have the facility to select 4 photos and use these on the form using their filename to display the images (not an attachment)

I have a function as below:

Code:
Public Function PickFile() As String

    Dim FO As Object
    
    Set FO = Application.FileDialog(3)
    FO.Show
    PickFile = FO.SelectedItems(1)
    
End Function


When I click browse on each photo on the form it calls the below:

Code:
Private Sub Photo1_Click()

    On Error GoTo errhandle
    Photo1 = PickFile()
    
exitErr:
    Exit Sub
    
errhandle:
    If Err.Number = 5 Then
        MsgBox "File Upload Cancelled", vbCritical, "File Upload"
        
    Else
        MsgBox "Error (" & Err.Number & ") - " & Err.Description & " Occurred."
    End If
    Resume exitErr

End Sub

Is there a way I can set the file dialog to open at the customer name\ job number of the current open form? The path would look something like the below.

"M:\Job Photos\" & CustomerID.Column(1) & "\" & JobNumberFormatted & "\"
 
This is the function I use. Check out the 2 links to Microsoft help.

Photo1
= FileDialog("Pick Photo", "M:\Job Photos\" & CustomerID.Column(1) & "\" & JobNumberFormatted & "\")

Code:
'-----------------------------------------------------------------
' Display windows file dialog box
'
'   dialogTitle      Prompt at top of dialog box
'   initialFileName  Starting path   "C:\"
'   patternCount     Number of Parameters passed in sPattern,
'                    0 if none, function will use sc_ALLFILESANDEXTENSIONS
'   searchPatterns   Optional Parameter pairs starting, of pattern names and file patterns
'               ex.
'               patternCount = 2
'               "Autocad (" & sc_ALLAUTOCADDRAWINGFILES & ")"    would be the display name
'               sc_ALLAUTOCADDRAWINGFILES                        would be the pattern
'
Public Function FileDialog(ByVal DialogTitle As String, _
                           ByVal InitialFileName As String, _
                           ByVal PatternCount As Integer, _
                           ParamArray SearchPatterns() As Variant) As String
    On Error GoTo errFileDialog
    Dim varFile As Variant
    Dim i As Integer
    Dim DialogType As MsoFileDialogTypeEnum

    ' Moved from Parameters, ignored by dialog box
    DialogType _
            = MsoFileDialogTypeEnum.msoFileDialogFilePicker
    ' https://learn.microsoft.com/en-us/office/vba/api/office.filedialog
    ' https://learn.microsoft.com/en-us/office/vba/api/overview/library-reference/filedialog-members-office
    With Application.FileDialog(DialogType)
        .AllowMultiSelect _
                    = False
        .InitialFileName _
                    = InitialFileName
        '.InitialView = initalView   ' Removed, ignored by dialog box
        .Title _
                = DialogTitle
        '.buttonName = buttonName  ' Removed Parameter, strange delay before change shows in dialog box
        .Filters.Clear
        If DialogType = MsoFileDialogTypeEnum.msoFileDialogFilePicker _
        Or DialogType = MsoFileDialogTypeEnum.msoFileDialogOpen Then
            'Clear out the current filters, and add our own.
            If PatternCount = 0 Then
                .Filters.Add "All Files", _
                             sc_ALL_FILES_AND_EXTENSIONS
            ElseIf UBound(SearchPatterns) >= PatternCount - 1 Then
                For i = 0 To PatternCount - 1 Step 2
                    .Filters.Add SearchPatterns(i), _
                                 SearchPatterns(i + 1)
                Next
            ElseIf UBound(SearchPatterns(0)) >= PatternCount - 1 Then
                Dim ArrayPattern() As Variant
                ArrayPattern = SearchPatterns(0)
                For i = 0 To PatternCount - 1 Step 2
                    .Filters.Add ArrayPattern(i), _
                                 ArrayPattern(i + 1)
                Next
            Else
                .Filters.Add "All Files", _
                             sc_ALL_FILES_AND_EXTENSIONS
            End If
        End If
        'Show the dialog box. If the .Show method returns True, the
        'user picked at least one file. If the .Show method returns
        'False, the user clicked Cancel.
        If .Show = True Then
           'Loop through each file selected returning 1st found.
           For Each varFile In .SelectedItems
              FileDialog = varFile
              Exit For
           Next
        Else
           FileDialog = vbNullString
        End If
   End With
doneFileDialog:
    On Error Resume Next
    Exit Function
errFileDialog:
    LogError "FileDialog"
    FileDialog = vbNullString
    Resume doneFileDialog
End Function
 

Users who are viewing this thread

Back
Top Bottom