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:

Gary McMaster

Well-known Member
Joined
Feb 8, 2009
Messages
1,977
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:

tonyyy

Well-known Member
Joined
Jun 24, 2015
Messages
1,647
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
 

Forum statistics

Threads
1,085,813
Messages
5,386,040
Members
401,980
Latest member
chaithanyakrishnagck

Some videos you may like

This Week's Hot Topics

Top