accesstoolbox/source/modules/AT_FileDialog.bas

Option Compare Database
Option Explicit

' ** Access Toolbox Module **
' on 2017-02-28,
' @author: Olivier Massot
' V 1.0

' Files selection dialogs

' ! Requires: Microsoft Office xx.0 Object Library.

Public Function FileDialog(Optional ByVal title As String = "Select File(s)", _
                            Optional ByVal directory As String = ".", _
                            Optional ByVal multi_select As Boolean = False, _
                            Optional ByVal name_filter As String = "", _
                            Optional ByVal type_filter As String = "", _
                            Optional separator As String = "|") As String
                                 
    Dim fd As Office.FileDialog
    Dim vFilename As Variant
    
    FileDialog = ""
    
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    fd.title = title
    fd.AllowMultiSelect = multi_select
    fd.InitialFileName = CreateObject("Scripting.FileSystemObject").GetAbsolutePathName(directory)
    fd.Filters.Clear
    fd.Filters.Add "All files", "*.*"
    If Len(name_filter) > 0 And Len(type_filter) > 0 Then
       If InStr(type_filter, ".") = 0 Then type_filter = "." & type_filter
       If InStr(type_filter, "*") = 0 Then type_filter = "*" & type_filter
       fd.Filters.Add name_filter, type_filter
       fd.FilterIndex = 2
    End If
    
    If fd.show() Then
    
      For Each vFilename In fd.SelectedItems
        If Len(FileDialog) > 0 Then FileDialog = FileDialog & separator
        FileDialog = FileDialog & vFilename
      Next
      
    End If
    
    Set fd = Nothing
  
End Function

Public Function DirectoryDialog(Optional ByVal title As String = "Select a directory", _
                                Optional ByVal directory As String = ".") As String
    Dim fd As Office.FileDialog
    Dim varDirname As Variant
    
    DirectoryDialog = ""
    
    Set fd = Application.FileDialog(msoFileDialogFolderPicker)
    
    fd.title = title
    fd.InitialFileName = CreateObject("Scripting.FileSystemObject").GetAbsolutePathName(directory)
    If fd.show() Then
      DirectoryDialog = fd.SelectedItems(1) & "\"
    End If
    Set fd = Nothing

End Function