VBA Tipp: Ordnerauswahl-Dialog 1

Aus DBWiki
Wechseln zu: Navigation, Suche

Anforderung

  • Ich möchte den Windows-Ordnerauswahl-Dialog aufrufen, um einen Ordner auszuwählen.
  • Als Ergebnis wird der Pfad zum ausgewählten Ordner geliefert.
  • Als zusätzliche Option kann die Auswahl auf einen bestimmten Ordner mit Unterordnern beschränkt werden.

Lösung

Das geht mit der folgenden Funktion, die in einem globalen Modul gespeichert wird.

Public Function Ordnerdialog(Optional Überschrift As String = vbNullString, _
                             Optional Basisordner As Variant = vbNullString) As String
 
 ' Quelle: www.dbwiki.net oder www.dbwiki.de
 ' Late Binding Methode, kein Verweis auf "Microsoft Shell Controls And Automation" notwendig
 
 ' Grundaufbau der Shell-Funktion BrowseForFolder:
 ' Function BrowseForFolder(Hwnd As Long, Title As String, Options As Long, [RootFolder]) As Folder
 
 ' Hwnd - Fenster-Handle
 ' Title - Überschrift
 ' Options - Optionen
 ' RootFolder - Basisordner. Es wird nur dieser eine Ordner mit seinen Unterordnern zur Auswahl angeboten.
 
 Dim SH As Object  'Shell-Objekt
 Dim SF As Object  'Folder2-Objekt
 
 Set SH = CreateObject("Shell.Application")
 
 ' Einige Optionen für den Parameter "Options"
 Const BIF_RETURNONLYFSDIRS = &H1        'nur Dateisystem-Verzeichnisse anzeigen
 Const BIF_BROWSEINCLUDEFILES = &H4000   'zusätzlich alle Dateien anzeigen
 Const BIF_BROWSEFILEJUNCTIONS = &H10000 'zusätzlich nur Dateiarchive z.B. zip-Dateien anzeigen
 
 Set SF = SH.BrowseForFolder(Application.hWndAccessApp, Überschrift, BIF_RETURNONLYFSDIRS, Basisordner)
 
 ' Benutzer hat Abbrechen gedrückt
 If SF Is Nothing Then
   Ordnerdialog = vbNullString
 ' Benutzer hat OK gedrückt
 Else
   Ordnerdialog = SF.Self.Path
 End If
 
 Set SH = Nothing
 Set SF = Nothing
 
End Function

Aufruf

 ' Beispiel 1: Ordnerauswahldialog öffnen (Standardwerte)
 Dim strPfad As String
 strPfad = Ordnerdialog
 If Not strPfad = "" Then
   MsgBox strPfad
 Else
   ' Abbrechen gedrückt
 End If
 ' Beispiel 2: Ordnerauswahldialog öffnen, mit Überschrift
 ' Nur den Ordner C:\ mit Unterordnern zur Auswahl anbieten. 
 Dim strPfad As String
 strPfad = Ordnerdialog("Bitte wählen Sie einen Ordner:", "C:\")
 If Not strPfad = "" Then
   MsgBox strPfad
 Else
   ' Abbrechen gedrückt
 End If
 ' Beispiel 3: Ordnerauswahldialog mit einer sog. Ordnerkonstante öffnen. 
 ' Nur den Ordner "Programme" mit Unterordnern zur Auswahl anbieten: Ordnerkonstante &H26 (Hexwert 26). 
 ' Weitere Konstanten siehe Web-Links: ShellSpecialFolderConstants enumeration
 Dim strPfad As String
 strPfad = Ordnerdialog(, &H26)
 If Not strPfad = "" Then
   MsgBox strPfad
 Else
   ' Abbrechen gedrückt
 End If

Wikilinks

Weblinks