'PUT IN MODULE 
'API declarations 
 
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 lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal _
lpString1 As String, ByVal lpString2 As String) As Long 
 
'Constants 
 
Private Const BIF_RETURNONLYFSDIRS = 1 
Private Const BIF_DONTGOBELOWDOMAIN = 2 
Private Const MAX_PATH = 260 
Private Const BIF_NEWDIALOGSTYLE = &H40 
 
'Types 
 
    Private Structure BrowseInfo
        Dim hWndOwner As Long
        Dim pIDLRoot As Long
        Dim pszDisplayName As Long
        Dim lpszTitle As Long
        Dim ulFlags As Long
        Dim lpfnCallback As Long
        Dim lParam As Long
        Dim iImage As Long
    End Structure
 
Public Function funcBrowseFolder(WindowHandle As Long, BrowseTitle As String) _
  As String 
 
'Opens a Treeview control that displays the directories in a computer 
 
Dim lpIDList As Long 
Dim sBuffer As String 
Dim szTitle As String 
Dim tBrowseInfo As BrowseInfo 
 
   szTitle = BrowseTitle '"Select the folder to save to" 
   With tBrowseInfo 
      .hWndOwner = WindowHandle 
      .lpszTitle = lstrcat(szTitle, "") 
      .ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN + _
        BIF_NEWDIALOGSTYLE 
   End With 
 
   lpIDList = SHBrowseForFolder(tBrowseInfo) 
 
   If (lpIDList) Then 
      sBuffer = Space$(MAX_PATH) 
      SHGetPathFromIDList lpIDList, sBuffer 
      sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1) 
      funcBrowseFolder = sBuffer 
   End If 
 
End Function

lpIDList = SHBrowseForFolder(tBrowseInfo)

Liebe Gr?sse,
Simon