Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA"
I have used the block of code many times in the course of my career, and it's saved me the most valuable thing we all have:
Option Explicit
' Date: 12th Apr 2020
' Author: TheRealMongoose
' Calls a file dialog with one line of code
' e.g
' fncGetFilePathTRM(Initial search directory, enumerated file typeS (multiple if needed), Caption)
' strfile = fncGetFilePathTRM("c:\temp", EXCELFILES + CSV + PPT, "Get EXCEL or CSV or PPT File path")
' Of note, multiple file types can be added together to give flexibility on file filters shown
' e.g. EXCELFILES + CSV + PPT
' Import this as a module
' See FileDialogExample()
' File types and filters built on basis of enumerated file type
' Requires reference to Office 15.0 Object Library
' ->Tools->References->Microsoft Office 15.0 Object Library (works with earlier versions too....)
' This also works in excel without modification :-)
' GLHFSS
Public Enum lngFileType
ALL = 256
ACCESSDB = 1
CSV = 2
EXCELFILES = 4
IMAGES = 8
PPT = 16
TXT = 32
WORDDOC = 64
ZIP = 128
End Enum
Dim fDialog As Office.FileDialog
Sub FileDialogExample()
Dim strfile As String
'Excel and CSV and PPT
strfile = fncGetFilePathTRM("c:\temp", EXCELFILES + CSV + PPT, "Get EXCEL or CSV or PPT File path")
If strfile = "" Then 'cancel was pressed
Exit Sub
Else
Debug.Print strfile
End If
'Access Only files
strfile = fncGetFilePathTRM("c:\temp", ACCESSDB, "Get AccessDB File path")
If strfile = "" Then 'cancel was pressed
'Stop your import etc here as no file was selected
Exit Sub
Else
'Continue with your import here...
Debug.Print strfile
End If
'All Files
strfile = fncGetFilePathTRM("c:\temp", ALL, "Get File path (All files shown)")
If strfile = "" Then 'cancel was pressed
Exit Sub
Else
Debug.Print strfile
End If
'Images
strfile = fncGetFilePathTRM("c:\temp", IMAGES, "Get Image File path")
If strfile = "" Then 'cancel was pressed
Exit Sub
Else
Debug.Print strfile
End If
End Sub
Function fncGetFilePathTRM(strIniDirectory As String, Optional lngTypes As lngFileType, Optional strCaption As String) As String
Dim strFilename As String
If IsMissing(lngTypes) Then lngTypes = ALL
If IsMissing(strCaption) Then strCaption = "Open File:"
Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
With fDialog
.InitialFileName = strIniDirectory
.AllowMultiSelect = False
.Title = strCaption
.Filters.Clear
AddFilters lngTypes
If .Show() < 0 Then
strFilename = .SelectedItems(1)
End If
End With
fncGetFilePathTRM = strFilename
End Function
Sub AddFilters(ByVal intFileExt As Integer)
If intFileExt > 256 Then 'Prevents All + ANOTHER
intFileExt = 256
End If
If intFileExt - ALL >= 0 Then
fDialog.Filters.Add "All Files", "*.*"
intFileExt = intFileExt - ALL
End If
If intFileExt - ZIP >= 0 Then
fDialog.Filters.Add "Zip Files", "*.zip; *.7z"
intFileExt = intFileExt - ZIP
End If
If intFileExt - WORDDOC >= 0 Then
fDialog.Filters.Add "Document Files", "*.doc*"
intFileExt = intFileExt - WORDDOC
End If
If intFileExt - TXT >= 0 Then
fDialog.Filters.Add "Text Files", "*.txt; *.bas; *.bat; *.prn"
intFileExt = intFileExt - TXT
End If
If intFileExt - PPT >= 0 Then
fDialog.Filters.Add "Powerpoint Files", "*.ppt*"
intFileExt = intFileExt - PPT
End If
If intFileExt - IMAGES >= 0 Then
fDialog.Filters.Add "Image Files", "*.jpg; *.jpeg; *.jpe; *.png; *.bmp; *.dib; *.tiff; *.gif; *.heic"
intFileExt = intFileExt - IMAGES
End If
If intFileExt - EXCELFILES >= 0 Then
fDialog.Filters.Add "Excel Files", "*.xl*; *.xml"
intFileExt = intFileExt - EXCELFILES
End If
If intFileExt - CSV >= 0 Then
fDialog.Filters.Add "Comma Separated Files", "*.csv" & Chr(0)
intFileExt = intFileExt - CSV
End If
If intFileExt = ACCESSDB Then
fDialog.Filters.Add "Access Files", "*.accdb; *.mdb" & Chr(0)
End If
End Sub
The nice thing about the code is the enumerated lngFileType.
strfile = fncGetFilePathTRM("c:\temp", EXCELFILES + CSV + PPT, "Get EXCEL or CSV or PPT File path")
Have a question about something in this article? You can receive help directly from the article author. Sign up for a free trial to get started.
Comments (0)