Excelguru Help Site - 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 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:

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:

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.