VBA Tipp: Dateiauswahl-Dialog 1

Aus DBWiki
Wechseln zu: Navigation, Suche

Anforderung

Ich möchte den Windows-Dateiauswahl-Dialog aufrufen, um eine oder mehrere Dateien auszuwählen, und den kompletten Dateipfad 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 gespeichert werden.

Option Compare Database
Option Explicit
 
Public Enum Dateitypen
  AlleDateien
  Programme
  MSAccess
  MSWord
  Bilder
End Enum
 
 
Public Function Dateidialog(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, kein Verweis auf "Microsoft Office xx.x Object Library" notwendig
 ' Quelle: http://www.dbwiki.net/
 
 Dim fd         As Object   'Office.FileDialog
 Dim i          As Long
 Dim strfilter  As String
 Const msoFileDialogFilePicker As Long = 3
 
 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 können ggf. erweitert 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.MSWord
 If (Dateityp And Dateitypen.MSWord) = Dateitypen.MSWord 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.MSAccess
 If (Dateityp And Dateitypen.MSAccess) = Dateitypen.MSAccess 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
 
 ' Filterindex auf den ersten anzuzeigenden Wert im Kombifeld der Dateitypen setzen
 ' 0 ist nicht erlaubt
 fd.FilterIndex = 1
 
 ' Mehrfachauswahl von Dateien
 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.
   For i = 1 To fd.SelectedItems.Count
     Dateidialog = Dateidialog & "|" & fd.SelectedItems(i)
   Next i
   Dateidialog = Mid(Dateidialog, 2)
 
 ' Benutzer hat Abbrechen gedrückt
 Else
   Dateidialog = vbNullString
 End If
 
 Set fd = Nothing
 
End Function

Aufruf

Hinweis: Um die über den Dateiauswahl-Dialog ausgewählte Datei anschließend gleich zu öffnen, kann die Funktion ShellExecute verwendet werden.

 ' 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: Dateiauswahldialog öffnen
 ' Argumente:
 '   - Schaltflächenbeschriftung
 '   - Dateitypen: Microsoft Access und Alle Dateien
 '   - Startordner
 Dim strPfad As String
 strPfad = Dateidialog("Übernehmen", MSAccess + AlleDateien, _
                       CurrentProject.Path & "\MeineDatenbank.mdb")
 If strPfad = vbNullString Then
   MsgBox "Abbrechen gedrückt"
 Else
   MsgBox strPfad
 End If
 ' Beispiel 3: Dateiauswahldialog öffnen
 ' Argumente:
 '   - Schaltflächenbeschriftung
 '   - Dateitypen: Programme und Alle Dateien
 '   - Startordner
 '   - Mehrfachauswahl von Dateien möglich
 Dim strPfad As String
 strPfad = Dateidialog("Übernehmen", Programme + AlleDateien, Environ("ProgramFiles"), _
                        "Dateien auswählen", True)
 If strPfad = vbNullString Then
   MsgBox "Abbrechen gedrückt"
 Else
   MsgBox strPfad
 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

Wikilinks

Weblinks