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

dan7055

Active Member
Joined
Jul 9, 2015
Messages
312
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?

Thanks
 
Last edited:

Excel Facts

Bring active cell back into view
Start at A1 and select to A9999 while writing a formula, you can't see A1 anymore. Press Ctrl+Backspace to bring active cell into view.
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:
Code:
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:
Upvote 0
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...

Code:
Sub GetFolderPath()

Dim diaFolder As FileDialog
Dim FolderPath As String
Dim Response
Dim msg As String

Set diaFolder = Application.FileDialog(msoFileDialogFolderPicker)
diaFolder.AllowMultiSelect = False
diaFolder.Show

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
            diaFolder.Show
            FolderPath = diaFolder.SelectedItems(1)
        ElseIf Response = vbNo Then
            MsgBox msg
        End If
    Loop
End If

End Sub

Cheers,

tonyyy
 
Upvote 0

Forum statistics

Threads
1,213,550
Messages
6,114,265
Members
448,558
Latest member
aivin

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top