This is one of my favourite functions to use in my projects. While VB's standard GetOpenFilename works great if you are in the correct directory, this saves my users time as I can tell it exactly where I want the dialog box to start looking... a very handy thing if you are opening files from different paths.
- Function to ask the user for a file name, but opening the window at a specific directory.
Examples of where this function shines:
- When you need to give the users options to open files from a variety of paths.
- Supports both conventional and UNC file paths!
- None identified at this time.
This function has been tested extensively with Excel 97 through Excel 2010, and should work in any version of Excel without any modifications.
VBA Code Required:
- Place the following code in a standard module of the workbook you wish to use it in.
- Make sure that the SetCurrentDirectoryA routine (a Windows API call) is at the very top of your module, just after any Option declaration (Option Explicit)
#If VBA7 Then Private Declare PtrSafe Function SetCurrentDirectoryA Lib "kernel32" (ByVal lpPathName As String) As Long #Else Private Declare Function SetCurrentDirectoryA Lib "kernel32" (ByVal lpPathName As String) As Long #End If Public Function GetOpenFilenameFrom(Optional sDirDefault As String) As Variant 'Author : Ken Puls (www.excelguru.ca) 'Macro Purpose: To ask for a file at a specified directory Dim sDirCurrent As String Dim lError As Long 'Make note of the current directory sDirCurrent = CurDir If sDirDefault = vbNullString Then 'If optional arguement not supplied then 'assign current directory as default sDirDefault = CurDir Else 'If option arguement is supplied, test path to ensure 'that it exists. If not, assign current directory If Len(Dir(sDirDefault, vbDirectory)) = 0 Then sDirDefault = sDirCurrent End If End If 'Change the drive and directory '*Drive change is unecessary if same, but takes as long to test ' as just changing it If Not Left(sDirDefault, 2) = "\\" Then 'Not a network drive, so use ChDir ChDrive Left(sDirDefault, 1) ChDir (sDirDefault) Else 'Network drive, so use API lError = SetCurrentDirectoryA(sDirDefault) If lError = 0 Then _ MsgBox "Sorry, I encountered an error accessing the network file path" ChDir (sDirDefault) End If 'Get the file's name & path, setting the filters to only display 'desired types. Help on the exact syntax can be found by looking 'up the GetOpenFilename method in the VBA help files GetOpenFilenameFrom = Application.GetOpenFilename _ ("Excel Files (*.xl*), *.xl*,All Files (*.*),*.*") 'Change the drive and directory back If Not Left(sDirCurrent, 2) = "\\" Then 'Not a network drive, so use ChDrive ChDrive Left(sDirCurrent, 1) ChDir (sDirCurrent) Else 'Network drive, so use API lError = SetCurrentDirectoryA(sDirCurrent) If lError = 0 Then _ MsgBox "Sorry, I encountered an error resetting the network file path" ChDir (sDirCurrent) End If End Function
- Call it from another routine, as shown below:
Sub GetMeAFile() 'Author : Ken Puls (www.excelguru.ca) 'Macro Purpose: To test the GetOpenFilenameFrom function Dim sWBToOpen As Variant sWBToOpen = GetOpenFilenameFrom(Range("A3").Value) If Not sWBToOpen = False Then Workbooks.Open (sWBToOpen) End Sub
I typically also check if the Directory exists before using this function.