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.
Verwendete 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