Private Declare Function SHBrowseForFolder Lib "shell32" _ 
  (lpbi As InfoT) As Long 
 
Private Declare Function CoTaskMemFree Lib "ole32" _ 
  (ByVal hMem As Long) As Long 
 
Private Declare Function lstrcat Lib "kernel32" Alias _ 
  "lstrcatA" (ByVal lpStr1 As String, _
  ByVal lpStr2 As String) As Long 
 
Private Declare Function SHGetPathFromIDList Lib "shell32" _ 
  (ByVal pList As Long, ByVal lpBuffer As String) As Long 
 
Private Type InfoT 
  hwnd As Long 
  Root As Long 
  DisplayName As Long 
  Title As Long 
  Flags As Long 
  FName As Long 
  lParam As Long 
  Image As Long 
End Type
 
Private Function GetAOrdner() As String 
  Dim xl As InfoT 
  Dim IDList As Long, RVal As Long 
  Dim PrgName As String 
 
  With xl 
    .hwnd = Me.hWnd
    .Title = lstrcat("Bitte wählen Sie ein Verzeichnis", "") 
    .Flags = 1 
  End With 
  IDList = SHBrowseForFolder(xl) 
  If IDList <> 0 Then 
    PrgName = Space(256) 
    RVal = SHGetPathFromIDList(IDList, PrgName) 
    CoTaskMemFree (IDList) 
    PrgName = LTrim(RTrim(PrgName)) 
  End If 
  GetAOrdner = PrgName 
End Function

Private Sub Command1_Click()

     Label1.Caption = GetAOrdner()

End Sub