Function To Get File Name From Specific Directory
Introduction:
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.
Macro Purpose:
- 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!
Macro Weakness(es):
- None identified at this time.
Versions Tested:
This function has been tested with Excel 97, and Excel 2003, and should also work with Excel 2000 and Excel 2002 (XP) 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)
Private Declare Function SetCurrentDirectoryA _
Lib "kernel32" (ByVal lpPathName As String) As Long
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
How to use the code:
- 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
Final Word:
I typically also check if the Directory exists before using this function.


