Postup:
Deklarujte:
Const BIF_RETURNONLYFSDIRS = &H1
Private Type SHITEMID
cb As Long
abID As Byte
End Type
Private Type ITEMIDLIST
mkid As SHITEMID
End Type
Private 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
Private Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, _
ByVal pszPath As String) As Long
Private Function BrowseDirectory() As String
Dim typInfo As BROWSEINFO
Dim typIDL As ITEMIDLIST
Dim lRet As Long
Dim lIDL As Long
Dim sPath As String
Dim pos As Integer
typInfo.hOwner = Form1.hWnd
'V případě potřeby
nahraďte vaším formulářem
typInfo.pidlRoot = 0&
typInfo.lpszTitle = "Zvolte
adresář"
typInfo.ulFlags = BIF_RETURNONLYFSDIRS
lIDL = SHBrowseForFolder(typInfo)
sPath = Space$(512)
lRet = SHGetPathFromIDList(ByVal lIDL, ByVal sPath)
If lRet Then
sPath = Left$(sPath, InStr(sPath, Chr$(0)) - 1) & "\"
BrowseDirectory = sPath
End If
End Function
Volání:
Call BrowseDirectory
|