If .InitialFileName isn't set, the "Select Folder" dialog FileDialog(msoFileDialogFolderPicker) uses the current directory of the application.
Is there any way to force the dialog to the "root" folder in Windows explorer ("This PC" in Windows 10, "My Computer" in earlier versions) ?
Public Function GetFolderName(InitPath As String) As String
With Application.FileDialog(msoFileDialogFolderPicker)
If InitPath <> "" Then
If Right$(InitPath, 1) <> "\" Then
InitPath = InitPath & "\"
End If
.InitialFileName = InitPath
Else
.InitialFileName = "" ' <-- What can I put here to start at "This PC" ?
End If
If .Show() = True Then
If .SelectedItems.Count > 0 Then
GetFolderName = .SelectedItems(1)
End If
End If
End With
End Function
Shell.Application.BrowseForFolder uses the magic number 17 to specify this:
? CreateObject("Shell.Application").BrowseForFolder(0, "", &H11, 17).Self.Path
I don't like to use BrowseForFolder, because if an initial folder is specified, the user is limited to this folder and below.
So apparently this is not possible with Application.FileDialog.
I applied Kostas' suggestion and implemented both methods (FileDialog and Shell.BrowseForFolder) in one function, depending on whether an initial path is passed to it.
See inline comments. This is my final version.
Public Function GetFolderName(sCaption As String, InitPath As String) As String
Dim sPath As String
' "Hybrid" approach:
' If InitPath is set, use Application.FileDialog because it's more convenient for the user.
' If not, we want to open the Folder dialog at "This PC", which is not possible with Application.FileDialog
' => then use Shell.Application.BrowseForFolder
If InitPath <> "" Then
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = sCaption
' FileDialog needs the init path to end with \ or it will select the parent folder
If Right$(InitPath, 1) <> "\" Then
InitPath = InitPath & "\"
End If
.InitialFileName = InitPath
If .Show() = True Then
If .SelectedItems.Count > 0 Then
sPath = .SelectedItems(1)
End If
End If
End With
Else
' https://ss64.com/vb/browseforfolder.html has all the flags and constants
Const BIF_RETURNONLYFSDIRS = &H1 ' default
Const BIF_EDITBOX = &H10 ' allow users to paste a path e.g. from Explorer
Const BIF_NONEWFOLDER = &H200 ' use this if users shouldn't be able to create folders from this dialog
Dim oShell As Object
Dim oFolder As Object
Set oShell = CreateObject("Shell.Application")
' 17 = ssfDRIVES is "This PC"
Set oFolder = oShell.BrowseForFolder(0, sCaption, BIF_RETURNONLYFSDIRS + BIF_EDITBOX, 17)
If Not oFolder Is Nothing Then
' .Self gets FolderItem from Folder object
' https://devblogs.microsoft.com/scripting/how-can-i-show-users-a-dialog-box-that-only-lets-them-select-folders/
sPath = oFolder.Self.Path
If Left$(sPath, 2) = "::" Then
sPath = "" ' User tricked the dialog into returning a GUID - invalid!
End If
End If
End If
GetFolderName = sPath
End Function
Collected from the Internet
Please contact [email protected] to delete if infringement.
Comments