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 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)
Code:
#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
How to use the code:
- Call it from another routine, as shown below:
Code:
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.
