Private Const MAX_PATH = 260
Private Const WM_USER = &H400
Private Const BFFM_INITIALIZED = 1
Private Const BFFM_SELCHANGED As Long = 2
Private Const BFFM_SETSTATUSTEXTA As Long = (WM_USER + 100)
Private Const BFFM_SETSTATUSTEXTW As Long = (WM_USER + 104)
Private Const BFFM_ENABLEOK As Long = (WM_USER + 101)
Private Const BFFM_SETSELECTIONA As Long = (WM_USER + 102)
Private Const BFFM_SETSELECTIONW As Long = (WM_USER + 103)
Private Const OFN_NONETWORKBUTTON As Long = &H20000
Private Const BIF_NEWDIALOGSTYLE As Long = &H40
Private Const BIF_RETURNONLYFSDIRS As Long = &H1
Private Const BIF_BROWSEINCLUDEFILES As Long = &H4000
Private Const BIF_STATUSTEXT As Long = &H4
Private Const LMEM_FIXED = &H0
Private Const LMEM_ZEROINIT = &H40
Private Const LPTR = (LMEM_FIXED Or LMEM_ZEROINIT)
 
' Zeigt den BrowseForFolder-Dialog an.
Public Function BrowseForFolder(DialogText As String, _
  DefaultPath As String, _
  OwnerhWnd As Long, _
  Optional ShowCurrentPath As Boolean = True, _
  Optional RootPath As Variant, _
  Optional NewDialogStyle As Boolean = False, _
  Optional IncludeFiles As Boolean = False) As String
 
 
  Dim biBrowseInfo As BROWSEINFO
  Dim lPIDL As Long
  Dim sBuffer As String
  Dim lBufferPointer As Long
 
  With biBrowseInfo
    ' Handle des übergeordneten Fensters
    .hOwner = OwnerhWnd
 
    ' PIDL des Rootordners zuweisen
    If Not IsMissing(RootPath) Then .pidlRoot = PathToPIDL(RootPath)
 
    ' Dialogtext zuweisen
    If ShowCurrentPath And DialogText = "$" Then DialogText = "" ' Wird intern 
    ' nicht zugelassen
    .lpszTitle = DialogText
 
    ' Stringbuffer für aktuell selektierten Pfad zuweisen
    If ShowCurrentPath Then .pszDisplayName = sBuffer
 
    ' Dialogeinstellungen zuweisen
   .ulFlags = OFN_NONETWORKBUTTON Or BIF_RETURNONLYFSDIRS Or _
      IIf(ShowCurrentPath, BIF_STATUSTEXT, 0) Or _
      IIf(NewDialogStyle, BIF_NEWDIALOGSTYLE, 0) Or _
      IIf(IncludeFiles, BIF_BROWSEINCLUDEFILES, 0)
 
    ' Callbackfunktion-Adresse zuweisen
    .lpfnCallback = FARPROC(AddressOf CallbackString)
 
    ' PIDL des vorselektierten Ordnerpfades zuweisen (wird im
    ' lpData-Parameter an die Callback-Funktion weitergeleitet)
    .lParam = PathToPIDL(DefaultPath)
  End With
 
  ' BrowseForFolder-Dialog anzeigen
  lPIDL = SHBrowseForFolder(biBrowseInfo)
 
  If lPIDL Then
    ' Stringspeicher reservieren
    sBuffer = Space$(MAX_PATH)
 
    ' Selektierten Pfad aus der zurückgegebenen PIDL ermitteln
    SHGetPathFromIDList lPIDL, sBuffer
 
    ' Nullterminierungszeichen des Strings entfernen
    sBuffer = Left$(sBuffer, InStr(sBuffer, vbNullChar) - 1)
 
    ' Selektierten Pfad zurückgeben
    BrowseForFolder = sBuffer
 
    ' Reservierten Task-Speicher wieder freigeben
    Call CoTaskMemFree(lPIDL)
  End If
 
  ' Stringspeicher wieder freigeben
  If ShowCurrentPath Then Call LocalFree(lBufferPointer)
End Function