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 SubThe 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)