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 hinterlegt wird:

Public Function Ordnerdialog(Optional Überschrift As String = vbNullString, _
                             Optional Basisordner As Variant = vbNullString) As String
 
 'Quelle: http://www.dbwiki.net/
 '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

Wiki-Links

Web-Links


Der Code wurde unter Access 2010 und Windows 7 erstellt und getestet.