Tipp 3.2 - Verzeichnisauswahldialog

Wie kann ich einen Verzeichnisauswahldialog aufrufen?

Mit dieser Funktion können Sie einen Verzeichnisauswahldialog aufrufen. Kopieren Sie einfach nachfolgenden Quellcode in die Zwischenablage und fügen Sie anschließend den Inhalt der Zwischenablage in ein neues Modul ein. Die Aufrufparameter finden Sie im Quellcode beschrieben.

Api-AufrufeVerwendete Win32-Api-Aufrufe und Typen: GetDesktopWindow, SHBrowseForFolder, SHGetPathFromIDList, CoTaskMemFree - BROWSEINFO

Beispiel:

Option Explicit
 
Public 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
 
Public Declare Function GetDesktopWindow _
    Lib "user32" () As Long
Public Declare Function SHBrowseForFolder _
    Lib "shell32.dll" Alias _
    "SHBrowseForFolderA" _
    (lpBrowseInfo As BROWSEINFO) As Long
Public Declare Function SHGetPathFromIDList _
    Lib "shell32.dll" Alias _
    "SHGetPathFromIDListA" _
    (ByVal pidl As Long, _
    ByVal pszPath As String) As Long
Public Declare Sub CoTaskMemFree _
    Lib "OLE32.dll" (ByVal pv As Long)
 
Public Function BrowseForFolder( _
                Optional sDlgTitle _
                As String = vbNullString) _
                As String
  '// -----------------------------------------------------
  '// Methode:   | Ruft den Verzeichnisauswahldialog auf
  '// -----------------------------------------------------
  '// Parameter: | sDlgTitle = optionaler Dialogtitel
  '// -----------------------------------------------------
  '// Rückgabe:  | ausgewählter Ordner
  '// -----------------------------------------------------
  '// Autor:     | Stefan Kulpa
  '//            | EDV Innovation & Consulting - Dormagen
  '// -----------------------------------------------------
  Const BIF_RETURNONLYFSDIRS  As Long = &H1
  Const MAXPATH               As Long = 260
  Dim uBrowseInfo             As BROWSEINFO
  Dim sPath                   As String
  Dim lPidl                   As Long
 
  On Error Resume Next
  uBrowseInfo.hOwner = GetDesktopWindow()
  uBrowseInfo.pidlRoot = 0&
  uBrowseInfo.ulFlags = BIF_RETURNONLYFSDIRS
  If Len(sDlgTitle) = 0 Then
    uBrowseInfo.lpszTitle = _
        "Bitte wählen Sie ein Verzeichnis:"
  Else
    uBrowseInfo.lpszTitle = sDlgTitle
  End If
  lPidl = SHBrowseForFolder(uBrowseInfo)
  sPath = VBA.Space$(MAXPATH)
  If SHGetPathFromIDList(ByVal lPidl, ByVal sPath) Then
    BrowseForFolder = _
        VBA.Left(sPath, VBA.InStr(sPath, _
        vbNullChar) - 1)
  End If
  Call CoTaskMemFree(lPidl)
 
End Function