VBA - Folder Picker - set where to start [duplicate]

Solution 1:

I have been using the following code (Not My Code) successfully for many years.

Sub Sample()
    Dim Ret

    '~~> Specify your start folder here
    Ret = BrowseForFolder("C:\")
End Sub

Function BrowseForFolder(Optional OpenAt As Variant) As Variant
     'Function purpose:  To Browser for a user selected folder.
     'If the "OpenAt" path is provided, open the browser at that directory
     'NOTE:  If invalid, it will open at the Desktop level

    Dim ShellApp As Object

     'Create a file browser window at the default folder
    Set ShellApp = CreateObject("Shell.Application"). _
    BrowseForFolder(0, "Please choose a folder", 0, OpenAt)

     'Set the folder to that selected.  (On error in case cancelled)
    On Error Resume Next
    BrowseForFolder = ShellApp.self.Path
    On Error GoTo 0

     'Destroy the Shell Application
    Set ShellApp = Nothing

     'Check for invalid or non-entries and send to the Invalid error
     'handler if found
     'Valid selections can begin L: (where L is a letter) or
     '\\ (as in \\servername\sharename.  All others are invalid
    Select Case Mid(BrowseForFolder, 2, 1)
    Case Is = ":"
        If Left(BrowseForFolder, 1) = ":" Then GoTo Invalid
    Case Is = "\"
        If Not Left(BrowseForFolder, 1) = "\" Then GoTo Invalid
    Case Else
        GoTo Invalid
    End Select

    Exit Function

Invalid:
     'If it was determined that the selection was invalid, set to False
    BrowseForFolder = False
End Function

Solution 2:

Here is a quick and dirty method I use all the time. The function below will only get the user to select the folder they want to start at - I think the simplest way to limit access to a given path is to perhaps check GetFolderName below against the path(s) you want to restrict e.g.

If GetFolderName = "C:\" then 
  MsgBox("This folder is not for you buddy")
  Exit Sub
end if

Also not my code :)

Public Function GetFolderName(Optional OpenAt As String) As String
Dim lCount As Long

GetFolderName = vbNullString

With Application.FileDialog(msoFileDialogFolderPicker)
    .InitialFileName = OpenAt
    .Show
    For lCount = 1 To .SelectedItems.Count
        GetFolderName = .SelectedItems(lCount)
    Next lCount
End With
End Function