AW: 'Datei öffnen' - Dialog mit Filter
08.04.2010 08:29:26
fcs
Hallo Stefan,
hier eine Function zur Dateiauswahl mit einigen Beispielen zum Aufrufen. Diese funktioniert unter Excel 97 möglicherweise nicht.
zum Öffnen einer Exceldatei mit Namens-Filter im Öffnen-Dialog sollte folgendes funktionieren
Sub aaTest()
Dim a
'Exceldateien - öffnen mit Dateifilter
a = Application.Dialogs(xlDialogOpen).Show(arg1:="130*")
If a = False Then Exit Sub 'Abbrechen wurde im Dialog gewählt
End Sub
Gruß
Franz
'##############################################################
'# Windows Vista - Excel 2007 - VBA 6.5.1040 #
'# fcs 2009-11-29 #
'# Anzeige von Dialogen zur Verzeichnis- und Dateiauswahl #
'# Makros sollten auch unter Excel 2003 lauffähig sein #
Option Explicit
Private Sub Test_fncSelectFile1()
Dim a
'Worddateien im Auswahldialog anzeigen
a = fncSelectFile(strDir:="C:\Users\Public\Test", _
strFilter:="*.doc;*.docx", strFilterName:="Word-Dateien", _
strTitel:="Bitte zu öffnende Word-Datei wählen")
'Wordvorlagen im Auswahldialog anzeigen
a = fncSelectFile(strDir:="C:\Users\Public\Test", _
strFilter:="*.dot;*.dotx", strFilterName:="Word-Vorlage", _
strTitel:="Bitte zu verwendende Word-Vorlage auswählen")
'Standard-Aufruf - Exceldateien im Auswahldialog anzeigen
a = fncSelectFile()
'Dateien mit Namens filter anzeigen
a = fncSelectFile(strDir:="C:\Users\Public\Test", strInitialName:="Test*", _
strFilter:="*.*", strFilterName:="Test-Dateien", _
strTitel:="Bitte Test-Datei wählen")
a = fncSelectFile(strDir:="C:\Users\Public\Test", strInitialName:="Test?0*.xls", _
strFilter:="*.*", bolClear:=False)
'Ausgewählten Dateinamen verarbeiten
MsgBox IIf(a = "", "Keine Datei ausgewählt", a), vbOKOnly + vbInformation, _
"Ausgewählter Dateiname"
End Sub
Private Sub Test_fncSelectFile2()
Dim a, intI As Long
'Worddateien im Auswahldialog anzeigen - Mehrfachauswahl möglich
a = fncSelectFile(strDir:="C:\Users\Public\Test", _
strFilter:="*.doc;*.docx", strFilterName:="Word-Dateien", _
strTitel:= _
"Bitte zu öffnende Word-Datei(en) wählen - Mehrfach-Auswahl ist möglich", _
bolMultiselect:=True)
'Ausgewählte Dateinamen verarbeiten
If IsArray(a) Then
For intI = LBound(a) To UBound(a)
MsgBox a(intI), vbOKOnly + vbInformation, _
"Ausgewählter Dateiname " & intI & " von " & UBound(a)
Next intI
Else
MsgBox "Keine Datei ausgewählt", vbOKOnly + vbInformation, _
"Ausgewählter Dateiname"
End If
End Sub
Function fncSelectFile(Optional strDir$, Optional strInitialName$, _
Optional strFilter$ = "*.xls;*.xlsx;*.xlsm;*.xlsb", _
Optional strFilterName$ = "Dateitypen", _
Optional strTitel$ = "Bitte zu öffnende Datei wählen", _
Optional strButton$ = "Datei wählen", _
Optional bolClear As Boolean = True, _
Optional bolMultiselect As Boolean = False) As Variant
'Auswahldialog zur Auswahl einer Datei
'Funktion gibt den/die im Dialog ausgewählten Dateinamen oder Leerstring zurück _
bei bolMultiselect = True wird ein Array mit den Dateinamen zurückgegeben
'strDir = Optionales Verzeichnis, in dem Datei ausgewählt werden soll
'strInitialName = Optionaler Filter für anzuzeigende Dateinamen _
(* und ? als Wildcards möglich), Beispiel: Test?0*.xls _
Hierbei strFilter auf "*.*" setzen
'strFilter = Filter für anzuzeigende Datei-Typen, _
Standard: "*.xls;*.xlsx;*.xlsm;*.xlsb"
'strFilterName = Beschreibung für Filter
'strTitel = Titel-Text des Dialogfensters _
Vorgabe: "Bitte zu öffnende Datei wählen"
'strButton = Text für den Öffnen-Button, Vorgabe: "Datei wählen"
'bolClear = True --> Filterliste des Dialogs wird vor Anzeige gelöscht _
False --> Der übergeben Filtertyp wird ggf. in der Liste ergänzt
Dim strCurDir, lngIndex As Long, bolFilter As Boolean, arrFiles() As String
strCurDir = VBA.CurDir 'Aktuelles Verzeichnis merken
If strDir "" Then
VBA.ChDir strDir
End If
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = bolMultiselect
.ButtonName = strButton
If strInitialName "" Then
.InitialFileName = strInitialName
Else
.InitialFileName = ""
End If
.Title = strTitel
With .Filters
If bolClear = True Then .Clear 'ggf. vorhandene Filter löschen
'Prüfen, ob vorgegebener Filter schon vorhanden
For lngIndex = 1 To .Count
If .Item(lngIndex).Extensions = strFilter Then
bolFilter = True
Exit For
End If
Next
'ggf. gewünschten Filter in Liste ergänzen
If bolFilter = False Then
lngIndex = .Count + 1
.Add strFilterName, strFilter, lngIndex
End If
End With
.FilterIndex = lngIndex
.InitialView = msoFileDialogViewProperties ' = msoFileDialogViewDetails
'Dateiauswahldialog anzeigen
If .Show = -1 Then
'Es wurde(n) Datei(en) ausgewählt
If bolMultiselect = False Then
fncSelectFile = .SelectedItems(1)
Else
ReDim arrFiles(1 To .SelectedItems.Count)
For lngIndex = 1 To .SelectedItems.Count
arrFiles(lngIndex) = .SelectedItems(lngIndex)
Next
fncSelectFile = arrFiles
End If
Else
'Dialog wurde abgebrochen
fncSelectFile = ""
End If
End With
'Aktuelles Verzeichnis auf gemerktes Verzeichnis zurücksetzen
VBA.ChDir strCurDir
End Function