VBA Tipp: Dateiauswahl-Dialog 2

Aus DBWiki
Wechseln zu: Navigation, Suche

Anforderung

Ich möchte den Windows-Dateiauswahl-Dialog aufrufen, um

  • entweder eine oder mehrere Dateien auszuwählen,
  • oder einen oder mehrere Ordner auszuwählen,

und den Pfad als Ergebnis anzuzeigen.

Lösung:

Das geht ab Access 2000 über das (undokumentierte) WizHook-Objekt mit der folgenden Enumeration und Funktion, die in einem globalen Modul hinterlegt werden:

Public Enum Dateitypen
  AlleDateien
  Programme
  MicrosoftAccess
  MicrosoftWord
  Bilder
End Enum
 
Public Function Dateidialog(Optional Ordnerauswahldialog As Boolean = False, _
                            Optional ButtonBeschriftung As String = "OK", _
                            Optional Dateityp As Dateitypen = AlleDateien, _
                            Optional Startordner As String = vbNullString, _
                            Optional Titel As String = vbNullString, _
                            Optional Mehrfachauswahl As Boolean = False) As String
 
 'Quelle: www.dbwiki.net oder www.dbwiki.de
 
 ' Grundaufbau 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
 
 ' hwndOwner: Fenster-Handle
 ' AppName (hat keine Bedeutung)
 ' DlgTitle = Titel
 ' OpenTitle = ButtonBeschriftung
 ' File - Gibt Pfad und Namen der ausgewählten Datei(en) oder Ordner zurück
 ' InitialDir - ist der Startordner (nur Ordnerpfad ohne Dateiname), Standard ist "Eigene Dokumente"
 ' Filter - Dateityp, Standardwert ist "Alle Dateien"
 ' FilterIndex - steuert den zuerst angezeigten Wert im Kombifeld für die Dateitypen
 
 ' 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 (unwirksam)
 ' 8:  Mehrfachauswahl
 ' 32: Ordnerauswahldialog
 ' 64: Wert im Parameter "View" berücksichtigen (unwirksam)
 
 ' Wenn fOpen = False:
 ' - Keine Mehrfachauswahl möglich
 ' - Ordner können nicht geöffnet werden (unwirksam)
 
 Dim strDatei As String
 Dim strFilter As String
 Dim lngFilterIndex As Long
 Dim lngFlags As Long
 
 'Filter:
 'Dateitypen zur Auswahl vorgeben (Trennzeichen |)
 'Die Dateierweiterungen sind nicht komplett, und müssen ggf. angepasst werden.
 'Auf die Enumerations-Werte nacheinander absteigend prüfen, d.h. höchster Wert zuerst
 
 'Enum Dateitypen.Bilder
 If (Dateityp And Dateitypen.Bilder) = Dateitypen.Bilder Then
   strFilter = strFilter & "Bilddateien (*.gif;*.jpg;*.png;*.bmp;*.pdf)" & "|"
 End If
 
 'Enum Dateitypen.MicrosoftWord
 If (Dateityp And Dateitypen.MicrosoftWord) = Dateitypen.MicrosoftWord Then
   strFilter = strFilter & "Microsoft Word (*.docx;*.docm;*.dotx;*.dotm;*.doc;*.dot;"
   strFilter = strFilter & "*.htm;*.html;*.rtf;*.mht;*.mhtml;*.xml;*.odt)" & "|"
 End If
 
 'Enum Dateitypen.MicrosoftAccess
 If (Dateityp And Dateitypen.MicrosoftAccess) = Dateitypen.MicrosoftAccess Then
   strFilter = strFilter & "Microsoft Access (*.accdb;*.mdb;*.adp;*.mda;*.accda;"
   strFilter = strFilter & "*.mde;*.accde;*.ade)" & "|"
 End If
 
 'Enum Dateitypen.Programme
 If (Dateityp And Dateitypen.Programme) = Dateitypen.Programme Then
   strFilter = strFilter & "Programme (*.exe)" & "|"
 End If
 
 'Enum Dateitypen.AlleDateien
 If (Dateityp And Dateitypen.AlleDateien) = Dateitypen.AlleDateien Then
   strFilter = strFilter & "Alle Dateien (*.*)" & "|"
 End If
 
 'Filterindex auf den ersten anzuzeigenden Wert im Kombifeld der Dateitypen setzen
 'Erster möglicher Wert ist 0
 lngFilterIndex = 0
 
 
 'Flags (Die Flags werden addiert)
 'Wenn Mehrfachauswahl gewählt wurde
 If Mehrfachauswahl = True Then
   lngFlags = lngFlags + 8
 End If
 
 'Wenn Ordnerauswahldialog gewählt wurde
 If Ordnerauswahldialog = True Then
   lngFlags = lngFlags + 32
 End If
 
 
 WizHook.Key = 51488399
 
 'Benutzer hat Bestätigungs-Button gedrückt
 If WizHook.GetFileName(Application.hWndAccessApp, "", Titel, ButtonBeschriftung, _
                        strDatei, Startordner, strFilter, _
                        lngFilterIndex, 0, lngFlags, True) = 0 Then
 
   'Mehrere Dateien werden durch "Tab" getrennt zurückgegeben.
   Dateidialog = strDatei
 
 'Benutzer hat Abbrechen gedrückt
 Else
   Dateidialog = vbNullString
 End If
 
End Function

Aufruf

 'Beispiel 1: Dateiauswahldialog mit Standardwerten öffnen
 Dim strPfad As String
 strPfad = Dateidialog
 If Not strPfad = "" Then
   MsgBox strPfad
 Else
   'Abbrechen gedrückt
 End If
 'Beispiel 2: Ordnerauswahldialog mit Standardwerten öffnen
 Dim strPfad As String
 strPfad = Dateidialog(True)
 If Not strPfad = "" Then
   MsgBox strPfad
 Else
   'Abbrechen gedrückt
 End If
 'Beispiel 3: Dateiauswahldialog öffnen,
 'Vorgabewerte: Schaltfläche "Übernehmen", Microsoft Access und Alle Dateien,
 'Ordner "D:\Eigene Dateien\Access\" (Keinen Dateinamen vorgeben!)
 Dim strPfad As String
 strPfad = Dateidialog(, "Übernehmen", MicrosoftAccess + AlleDateien, _
                       "D:\Eigene Dateien\Access\")
 If Not strPfad = "" Then
   MsgBox strPfad
 Else
   'Abbrechen gedrückt
 End If
 'Beispiel 4: Dateiauswahldialog öffnen,
 'Vorgabewerte: Schaltfläche "Übernehmen", Programme und Alle Dateien, Ordner Programme,
 '"Dateien auswählen", Mehrfachauswahl möglich
 Dim strPfad As String
 strPfad = Dateidialog(, "Übernehmen", Programme + AlleDateien, Environ("ProgramFiles"), _
                        "Dateien auswählen", True)
 If Not strPfad = "" Then
   MsgBox strPfad
 Else
   'Abbrechen gedrückt
 End If
 
 
 'Falls mehrere Dateien ausgewählt wurden, Dateien auflisten
 Dim varitem As Variant
 Dim arr() As String
 arr() = Split(strPfad, vbTab)
 For Each varitem In arr()
   Debug.Print varitem
 Next varitem


Wiki hinweis.png Hinweis: Der Code wurde unter Access 2010 und Windows 7 erstellt und getestet. Einige Parameter wurden als unwirksam erkannt, die vermutlich in früheren Access/Windows-Konstellationen wirksam waren.


Wiki-Links

Web-Links