Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

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

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.

like image 495
Andre Avatar asked Feb 18 '21 16:02

Andre


1 Answers

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
like image 90
Andre Avatar answered Oct 19 '22 20:10

Andre