VBA Tipp: Dateiauswahl-Dialog 1

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 Ordner auszuwählen (keine Mehrfachauswahl),

und den Pfad als Ergebnis anzuzeigen.

Lösung:

Das geht ab Access 2002 über das FileDialog-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 Startpfad As String = vbNullString, _
                            Optional Titel As String = vbNullString, _
                            Optional Mehrfachauswahl As Boolean = False) As String
 
 'Late Binding Methode, kein Verweis auf Microsoft Office xx.x Object Library notwendig
 'Der Code ist ab Access 2002 lauffähig.
 'Quelle: www.dbwiki.net oder www.dbwiki.de
 
 Dim fd As Object   'FileDialog
 Dim i As Integer
 Dim arr() As String
 Dim strfilter As String
 Const msoFileDialogFilePicker = 3
 Const msoFileDialogFolderPicker = 4
 
 'wenn Ordnerauswahldialog
 If Ordnerauswahldialog = True Then
   Set fd = Application.FileDialog(msoFileDialogFolderPicker)
 
 'wenn Dateiauswahldialog
 Else
 
   Set fd = Application.FileDialog(msoFileDialogFilePicker)
 
   'Filter:
   fd.Filters.Clear
 
   'Bestimmte Dateitypen werden zur Auswahl vorgegeben.
   'i legt die Reihenfolge in der Auflistung (=Filterindex) fest.
   'Die Dateierweiterungen sind nicht komplett, und müssen ggf. angepasst werden.
 
   'Enum Dateitypen.Bilder
   If (Dateityp And Dateitypen.Bilder) = Dateitypen.Bilder Then
     i = i + 1
     fd.Filters.Add "Bilddateien", "*.gif;*.jpg;*.png;*.bmp;*.pdf", i
   End If
 
   'Enum Dateitypen.MicrosoftWord
   If (Dateityp And Dateitypen.MicrosoftWord) = Dateitypen.MicrosoftWord Then
     i = i + 1
     strfilter = "*.docx;*.docm;*.dotx;*.dotm;*.doc;*.dot;"
     strfilter = strfilter & "*.htm;*.html;*.rtf;*.mht;*.mhtml;*.xml;*.odt"
     fd.Filters.Add "Microsoft Word", strfilter, i
   End If
 
   'Enum Dateitypen.MicrosoftAccess
   If (Dateityp And Dateitypen.MicrosoftAccess) = Dateitypen.MicrosoftAccess Then
     i = i + 1
     strfilter = "*.accdb;*.mdb;*.adp;*.mda;*.accda;*.mde;*.accde;*.ade"
     fd.Filters.Add "Microsoft Access", strfilter, i
   End If
 
   'Enum Dateitypen.Programme
   If (Dateityp And Dateitypen.Programme) = Dateitypen.Programme Then
     i = i + 1
     fd.Filters.Add "Programme", "*.exe", i
   End If
 
   'Enum Dateitypen.AlleDateien
   If (Dateityp And Dateitypen.AlleDateien) = Dateitypen.AlleDateien Then
     i = i + 1
     fd.Filters.Add "Alle Dateien", "*.*", i
   End If
 
 End If
 
 'Filterindex auf den ersten anzuzeigenden Wert im Kombifeld der Dateitypen setzen
 '0 ist nicht erlaubt
 fd.FilterIndex = 1
 
 'Mehrfachauswahl von Dateien (nicht möglich für Ordner)
 fd.AllowMultiSelect = Mehrfachauswahl
 
 'Fenstertitel
 fd.Title = Titel
 
 'Beschriftung des Bestätigungs-Buttons
 fd.ButtonName = ButtonBeschriftung
 
 'Kompletter Dateipfad oder nur Ordnerpfad als Startordner
 fd.InitialFileName = Startpfad
 
 
 'Dialog Anzeigen:
 
 'Benutzer hat Bestätigungs-Button gedrückt
 If fd.Show = True Then
 
   'Mehrere Dateien werden durch "|" getrennt zurückgegeben.
   ReDim arr(fd.SelectedItems.Count - 1)
   For i = 0 To fd.SelectedItems.Count - 1
     arr(i) = fd.SelectedItems(i + 1)
   Next i
   Dateidialog = Join(arr(), "|")
 
   'Alternativ: Zusätzliche Option:
   'wenn die Buttonbeschriftung "Öffnen" ist, erste gewählte Datei öffnen
   If ButtonBeschriftung = "Öffnen" Then
     'Code zum Öffnen der Datei hier einfügen.
     'Siehe im DBWiki unter: "VBA Tipp: Anwendung mit ShellExecute starten"
     'Der Dateiname ist aus fd.SelectedItems(1) zu entnehmen.
   End If
 
 'Benutzer hat Abbrechen gedrückt
 Else
   Dateidialog = vbNullString
 End If
 
 Set fd = Nothing
 
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", Dateitypen: Microsoft Access und Alle Dateien,
 'Startordner "D:\Eigene Dateien\Access\" oder Startpfad "D:\Eigene Dateien\Access\MeineDatenbank.mdb"
 Dim strPfad As String
 strPfad = Dateidialog(, "Übernehmen", MicrosoftAccess + AlleDateien, _
                       "D:\Eigene Dateien\Access\MeineDatenbank.mdb")
 If Not strPfad = "" Then
   MsgBox strPfad
 Else
   'Abbrechen gedrückt
 End If
 'Beispiel 4: Dateiauswahldialog öffnen,
 'Vorgabewerte: Schaltfläche "Übernehmen", Dateitypen: Programme und Alle Dateien, 
 'Startordner: Ordner Programme, Überschrift: "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 im Direktfenster auflisten
 Dim varitem As Variant
 Dim arr() As String
 arr() = Split(strPfad, "|")
 For Each varitem In arr()
   Debug.Print varitem
 Next varitem

Wiki-Links

Web-Links