VBA Tipp: Ordnerauswahl-Dialog 4

Aus DBWiki
Wechseln zu: Navigation, Suche

Anforderung

Ich möchte den Windows-Ordnerauswahl-Dialog aufrufen, um einen oder mehrere Ordner auszuwählen und den oder die Ordnerpfade als Rückgabewert anzuzeigen.

Lösung

Das geht ab Access 2000 über das (undokumentierte) WizHook-Objekt mit der folgenden VBA-Funktion, die in einem allgemeinen (globalen) Modul gespeichert wird.


Argumente der Funktion:

  • Startordner: Vorgabe eines Startverzeichnisses
  • ButtonBeschriftung: Alternative Beschriftung der Bestätigungs-Schaltfläche. Der Standardwert ist Öffnen.
  • Fenstertitel: Alternativer Titel des Ordnerauswahl-Dialogfensters. Der Standardwert ist Datei öffnen.
  • Mehrfachauswahl: Wenn True, können mehrere Ordner ausgewählt werden. Der Standardwert ist False.
Public Function Ordnerdialog(Optional Startordner As String, _
                             Optional ButtonBeschriftung As String, _
                             Optional Fenstertitel As String, _
                             Optional Mehrfachauswahl As Boolean) As String
 
 ' Quelle: http://www.dbwiki.net/
 
 ' Aufbau der WizHook.GetFileName-Funktion:
 ' WizHook.GetFileName(hwndOwner As Long, AppName As String, DlgTitle As String, _
 '                     OpenTitle As String, File As String, InitialDir As String, _
 '                     Filter As String, FilterIndex As Long, View As Long, _
 '                     flags As Long, fOpen As Boolean) As Long
 
 ' Argumente der WizHook.GetFileName-Funktion:
 '  • hwndOwner: Fenster-Handle, Standardwert: 0
 '  • AppName: Hat keine Bedeutung, Standardwert: Leerstring
 '  • DlgTitle: Fenstertitel, Standardwert: Leerstring
 '  • OpenTitle: Beschriftung der Bestätigungs-Schaltfläche, Standardwert: Leerstring
 '  • File: Argument ByRef, Gibt Pfad und Namen der ausgewählten Datei(en) zurück
 '  • InitialDir: Startordner, nur Ordnerpfad ohne Dateiname, Standardwert: Leerstring
 '  • Filter: Vorgabe von einem oder mehreren Dateitypen (nur bei Dateiauswahldialog)
 '            Standardwert: Leerstring (""), vbNullString ist ungültig, erzeugt 'Alle Dateien (*.*)'
 '  • FilterIndex: Steuert den zuerst angezeigten Wert im Kombifeld für die Dateitypen, Standardwert: 0
 '  • View: (ist unwirksam)
 '     0: Detailansicht
 '     1: Vorschauansicht
 '     2: Eigenschaften
 '     3: Liste
 '     4: Miniaturansicht
 '     5: Große Symbole
 '     6: Kleine Symbole
 '  • flags: Die Werte werden addiert.
 '     4:  Set Current Dir
 '     8:  Mehrfachauswahl
 '     32: Ordnerauswahldialog
 '     64: Wert des Parameters 'View' berücksichtigen (ist unwirksam)
 '  • fOpen:
 '     Standardwert: True (False ist unbrauchbar)
 
 Dim strOrdner  As String
 Dim lngFlags   As Long
 
 ' Flags für Mehrfachauswahl
 If Mehrfachauswahl Then
   lngFlags = lngFlags + 8
 End If
 
 ' Flags für Ordnerauswahldialog
 lngFlags = lngFlags + 32
 
 ' Zugangsschlüssel für das WizHook-Objekt
 WizHook.Key = 51488399
 
 ' Der Benutzer hat die Bestätigungs-Schaltfläche gedrückt
 If WizHook.GetFileName(Application.hWndAccessApp, vbNullString, Fenstertitel, _
                        ButtonBeschriftung, strOrdner, Startordner, "", _
                        0, 0, lngFlags, True) = 0 Then
 
   ' Mehrere Ordner werden durch 'Tab' getrennt zurückgegeben.
   Ordnerdialog = strOrdner
 
 ' Der Benutzer hat 'Abbrechen' gedrückt
 Else
   Ordnerdialog = vbNullString
 End If
 
End Function

Aufruf

 Dim strPfad  As String
 Dim varelem  As Variant
 Dim arr()    As String
 
 ' Beispiel 1: Ordnerauswahldialog mit Standardwerten öffnen
 strPfad = Ordnerdialog
 
 ' Beispiel 2: Ordnerauswahldialog mit Argumenten öffnen
 ' Argumente: Startordner, Schaltflächenbeschriftung, Fenstertitel, Mehrfachauswahl
 strPfad = Ordnerdialog(CurrentProject.Path, "Übernehmen", "Mein Titel", True)
 
 
 ' Auswertung des Rückgabewerts
 If Len(strPfad) Then
   MsgBox strPfad
 Else
   ' Abbrechen gedrückt
 End If
 
 ' Falls mehrere Ordner ausgewählt wurden, Ordner im Direktfenster auflisten
 arr() = Split(strPfad, vbTab)
 For Each varelem In arr()
   Debug.Print varelem
 Next varelem

Weblinks