FileDialog(msoFileDialogFolderPicker) - how to set initial path to "root" / "This PC"?

Question

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.

Answer 1

所以显然这是不可能的Application.FileDialog。

我应用了 Kostas 的建议，并在一个函数中实现了两种方法（FileDialog 和 Shell.BrowseForFolder），具体取决于是否向其传递初始路径。

请参阅内嵌评论。这是我的最终版本。

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