时间戳

首页 > 解决方案 > FileDialog(msoFileDialogFolderPicker) - 如何将初始路径设置为“root”/“This PC”？

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

问题描述

如果.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使用幻数 17 来指定：

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

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

标签： excelvbams-access

解决方案

所以显然这是不可能的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

推荐阅读