Okno wyboru folderu

 

Istnieje czasem potrzeba dialogu z użytkownikiem w postaci pytania o folder.

Poniższy kod zawiera deklarację odpowiedniej funkcji API (32-bit) oraz funkcji użytkownika zwracającej w postaci ciągu znaków wskazaną przez nas ścieżkę (przykład pochodzi z samples.xls):

 

'32-bit API declarations
Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long

Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long

Public Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type


Function PobierzFolder(Optional Msg) As String
 

Dim bInfo As BROWSEINFO
Dim ścieżka As String
Dim r As Long, x As Long, pos As Integer

' Folder główny - Pulpit
    bInfo.pidlRoot = 0&

' Tytuł okna dialogowego
    If IsMissing(Msg) Then
        bInfo.lpszTitle = "Wybierz folder"
    Else
        bInfo.lpszTitle = Msg
    End If

' Typ zwracanego foldera
    bInfo.ulFlags = &H1

' Wyświatlanie okna dialogowego
    x = SHBrowseForFolder(bInfo)

' Analiza zwróconej wartości
    ścieżka = Space$(512)
    r = SHGetPathFromIDList(ByVal x, ByVal ścieżka)
    If r Then
        pos = InStr(ścieżka, Chr$(0))
        PobierzFolder = Left(ścieżka, pos - 1)
    Else
        PobierzFolder = ""
    End If

End Function
 

Tak wygląda wyświetlane okno:

 

---