'--------------------------------------------------------- СОРС ЗА ФОРМАТА --------------------------------------

Private Sub Command1_Click()

imefolder = BrowseForFolder 'Присвояване на избраното в променлива за удобство

If imefolder = "" Then 'IF проверяващ дали сме избрали нещо

'Нищо

Else

MsgBox "Вие избрахте" & imefolder, vbInformation, "Пример за избор"

End If

End Sub

' -------------------------------------------------------- СОРС ЗА МОДУЛА --------------------------------------------

Private Type BrowseInfo

hWndOwner As Long

pIDLRoot As Long

pszDisplayName As Long

lpszTitle As String

ulFlags As Long

lpfnCallback As Long

lParam As Long

iImage As Long

End Type

Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)

Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long

Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long

Private Declare Function GetActiveWindow Lib "user32" () As Long

Public Function BrowseForFolder(Optional sCaption As String = "Select a folder", Optional sDefault As String) As String

Const BIF_RETURNONLYFSDIRS = 1

Const MAX_PATH = 260

Dim lPos As Integer, lpIDList As Long, lResult As Long

Dim sPath As String, tBrowse As BrowseInfo

With tBrowse

.hWndOwner = GetActiveWindow

.lpszTitle = sCaption

.ulFlags = BIF_RETURNONLYFSDIRS '

End With

lpIDList = SHBrowseForFolder(tBrowse)

If lpIDList Then

sPath = String$(MAX_PATH, 0)

SHGetPathFromIDList lpIDList, sPath

CoTaskMemFree lpIDList

lPos = InStr(sPath, vbNullChar)

If lPos Then

BrowseForFolder = Left$(sPath, lPos - 1)

If Right$(BrowseForFolder, 1) <> "\" Then

BrowseForFolder = BrowseForFolder & "\"

End If

End If

Else

BrowseForFolder = sDefault

End If

End Function