Skip to content
Snippets Groups Projects
SelectFolder.bas 1.27 KiB
Newer Older
''
' Function to display folder selection box
'
' @param    message (String)  Optional message text displayed above selection tree
' @return   Selected folder (full path) or empty string in case dialog has been cancelled
' @author   Christoph Juengling
' @comment  Base code found at http://www.office-loesung.de (guest account, author identifies as "Georg")
'
Public Function SelectFolder(Optional ByVal message As String = "") As String

' Define BROWSEINFO structure constants not found in the library
Const BIF_RETURNONLYFSDIRS = &H1
Const BIF_NEWDIALOGSTYLE = &H40
Const BIF_EDITBOX = &H10
Const BIF_NONEWFOLDERBUTTON = &H200

#If EARLY_BINDING Then
    ' Needs "Microsoft Shell Controls and Automation" reference
    Dim AppShell As shell32.Shell
    Set AppShell = New shell32.Shell
#Else
    Dim AppShell As Object
    Set AppShell = CreateObject("Shell.Application")
#End If

Dim flags As Long
Dim BrowseDir As Variant
Dim folder As String

'------------------------

flags = BIF_RETURNONLYFSDIRS Or BIF_NEWDIALOGSTYLE Or BIF_EDITBOX Or BIF_NONEWFOLDERBUTTON
Set BrowseDir = AppShell.BrowseForFolder(frmMain.hwnd, message, flags, ssfDRIVES)

If BrowseDir Is Nothing Then
    SelectFolder = ""
Else
    folder = BrowseDir.Items().Item().path
    SelectFolder = folder
End If

End Function