Results 1 to 3 of 3

Thread: I need a command like "GetOpenFileName" but for folders instead of files
Thanks Thanks: 0 Likes Likes: 0

  1. #1
    Board Regular
    Join Date
    Jul 2015
    Post Thanks / Like
    0 Post(s)
    0 Thread(s)

    Default I need a command like "GetOpenFileName" but for folders instead of files

    Hello all,

    I am in the process of writing a macro, that will allow me to manually select multiple folders, after which, the macro will go into each folder one by one and find a different folder inside of each manually selected folder and copy that over to a database. I am aware of the command: application.getopenfilename, however it will not work for selecting folders instead of files. Does anyone know of an alternative I can use?

    Last edited by dan7055; Mar 16th, 2016 at 10:17 AM.

  2. #2
    Board Regular
    Join Date
    Feb 2009
    Massachusetts, USA
    Post Thanks / Like
    0 Post(s)
    0 Thread(s)

    Default Re: I need a command like "GetOpenFileName" but for folders instead of files

    Hi Dan,

    Here's an API I use occasionally. Don't remember where I got it or who wrote it. I don't know if it can be set to do multi select.

    Hope it helps.

    In a standard module:
    Option Explicit
    Public Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
    Public Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
    Public Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
    Public Type BROWSEINFO
           hOwner As Long                  'handle to the window calling this
           pidlRoot As Long                'ID List point to the top most folder, set this to 0
           pszDisplayName As Long          'Buffer used to hold the display name of the folder selected by the user
           lpszTitle As String             'the caption of the browse dialog
           uFlags As Long                  'the flags to determine what to browse for
           lpfn As Long                    'the address of the callback function, set to Null
           lParam As Long                  'a value passed to the callback function
           iImage As Long                  'a buffer to hold the index to the image of selected folder
    End Type
    Public Const BIF_RETURNONLYFSDIRS = &H1 ' - file system folders only
    Public Const BIF_BROWSEFORCOMPUTER = &H1000 ' - allows you to browse for a computer
    Public Const BIF_BROWSEFORPRINTER = &H2000 '- browse Printers Folder
    Public Sub Show_Browse()
    Dim bi As BROWSEINFO 'structure we will fill later
    Dim pIdList As Long 'the return value (pointer to ID List)
    Dim strFolder As String 'extracted value from pIdList
    Dim lHWnd As Long
    strFolder = String$(255, Chr$(0)) 'create buffer large enough to hold folder path
    With bi 'populate BROWSEINFO structure
        .hOwner = lHWnd ' hwnd of the calling form
        .uFlags = BIF_RETURNONLYFSDIRS ' browse for sysfolders
        .pidlRoot = 0 '
        .lpszTitle = "Select a folder" & Chr$(0) 'zero-terminated string
    End With
    pIdList = SHBrowseForFolder(bi) 'initial fucntion call to get ID List pointer
    'extract file path
    If SHGetPathFromIDList(ByVal pIdList, ByVal strFolder) Then
        MsgBox Left$(strFolder, InStr(strFolder, Chr$(0)) - 1)
    End If
    End Sub
    Last edited by Gary McMaster; Mar 16th, 2016 at 10:53 AM. Reason: typo
    Murphy's Fifth Law: If anything absolutely can NOT go wrong, it will anyway.

  3. #3
    Board Regular tonyyy's Avatar
    Join Date
    Jun 2015
    Grants Pass, Oregon
    Post Thanks / Like
    6 Post(s)
    1 Thread(s)

    Default Re: I need a command like "GetOpenFileName" but for folders instead of files

    I'm pretty sure the FolderPicker function doesn't allow for the selection of multiple folders, so the code below provides a loop to work around this limitation...

    Sub GetFolderPath()
    Dim diaFolder As FileDialog
    Dim FolderPath As String
    Dim Response
    Dim msg As String
    Set diaFolder = Application.FileDialog(msoFileDialogFolderPicker)
    diaFolder.AllowMultiSelect = False
    On Error Resume Next
    FolderPath = diaFolder.SelectedItems(1)
    If FolderPath <> "" Then
        Do Until Response = vbNo
            msg = msg & FolderPath & vbCrLf
            Response = MsgBox(prompt:="Choose another?", Buttons:=vbYesNo)
            If Response = vbYes Then
                FolderPath = diaFolder.SelectedItems(1)
            ElseIf Response = vbNo Then
                MsgBox msg
            End If
    End If
    End Sub

    Windoze 7 / Excel 2010

    How to post your Excel data
    How to post your vba code

Some videos you may like

User Tag List

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts