Newer
Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
''
' 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