geht mit der Win-API
Type BrowseInfo
hwndOwner As Long
pIDLRoot As Long
pszDisplayName As Long
lpszTitle As Long
ulFlags As Long
lpfnCallback As Long
lParam As Long
iImage As Long
End Type
Const vbNullChar = &H0
Const vbNullString = &H0
Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Declare Function SHGetPathFromIDList Lib "shell32" (Byval pidList As Long, Byval lpBuffer As String) As Long
Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (Byval lpString1 As String, Byval lpString2 As String) As Long
Function BrowseForFolder(Titel As String, hWnd As Long) As String
Dim lngIDList As Long
Dim strBuffer As String
Dim usrBrowseInfo As BrowseInfo
usrBrowseInfo.hwndOwner = hWnd
usrBrowseInfo.lpszTitle = lstrcat("C:\Temp" & vbNullChar, "")
usrBrowseInfo.ulFlags = 3
usrBrowseInfo.pIDLRoot = lstrcat("C:\Temp", "")
lngIDList = SHBrowseForFolder(usrBrowseInfo)
If (lngIDList) Then
strBuffer = Space(260)
SHGetPathFromIDList lngIDList, strBuffer
strBuffer = Fulltrim(strBuffer)
If Right(strBuffer, 1) <> "\" Then strBuffer = strBuffer & "\"
BrowseForFolder = strBuffer
End If
End Function
Sub Click(Source As Button)
Msgbox BrowseForFolder(0,&H0)
End Sub