excel - FileDialog(msoFileDialogFolderPicker) - 如何将初始路径设置为 "root"/ "This PC"？

Question

如果 .InitialFileName未设置，“选择文件夹”对话框 FileDialog(msoFileDialogFolderPicker)使用 当前目录的应用程序。
有没有办法强制对话框进入 Windows 资源管理器中的“根”文件夹(Windows 10 中的“这台电脑”，早期版本中的“我的电脑”)？

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使用魔数(Magic Number) 17 来指定:

? CreateObject("Shell.Application").BrowseForFolder(0, "", &H11, 17).Self.Path

我不喜欢使用 BrowseForFolder，因为如果指定了初始文件夹，则用户仅限于此文件夹及以下文件夹。

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