Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1148to1152
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

'Datei öffnen' - Dialog mit Filter

'Datei öffnen' - Dialog mit Filter
Stefan
Guten Morgen zusammen,
ist zwar noch früh, aber ich frage schon mal in die Runde, ob mir jemand helfen kann.
Ich habe verschiedene Dateien (auch Word, bekomme ich aber mit CreateObject hin), die alle zum Anfang des Dateinamens eine Ordnungszahl (z.B. 130) haben. Nun möchte ich den 'Öffnen' -Dialog aufrufen und es sollen nicht alle Dateien, sondern nur die angezeigt werden, die mit 130 beginnen. Mit getopenfilename und dialogopen habe ich das nicht hinbekommen. Kann mir da jemand einen Tipp geben ?
Vielen Dank.
Gruß
Stefan K.

12
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
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

Anzeige
AW: 'Datei öffnen' - Dialog mit Filter
08.04.2010 09:25:24
Stefan
Hi Franz,
erstmal vielen Dank.
Das mit dem (arg1:="130*") ist schon ganz nah am gewünschten Ergebnis. Es werden nur die entsprechenden Dateien angezeigt. Aber bei xlDialogOpen wird ja gleich die Datei geöffnet und das führt zum Fehler, wenn es eine Word-Datei ist. Die wollte ich ja mit CreateObject öffnen. Schade.
Und das mit fncSelectFile1() scheint in Excel 97 nicht zu funktionieren (Sub oder Funktion nicht definiert).
Aber dennoch Danke für die Mühe.
Gruß
Stefan K.
AW: War das nicht gestern schon Thema?
08.04.2010 08:32:32
JOWE
Hallo Stefan,
habe gestern noch dies gefunden:
Sub getFileName()
Dim oFileDialog As FileDialog
Dim myErgebnis, myFilter As String
Dim vItem As Variant
myFilter = "C:\temp\130*.xls" 'Hier anpassen
Set oFileDialog = Application.FileDialog(msoFileDialogFilePicker)
With oFileDialog
.Title = "Datei auswählen"
.ButtonName = "Datei merken"
.InitialFileName = myFilter
.InitialView = msoFileDialogViewList
.AllowMultiSelect = False
If .Show = True Then
For Each vItem In .SelectedItems
myErgebnis = vItem
Next
End If
End With
Set oFileDialog = Nothing
MsgBox "Ausgewählte Datei: " & myErgebnis
End Sub

Gruß
Jochen
Anzeige
AW: War das nicht gestern schon Thema?
08.04.2010 09:09:29
Stefan
Hi Jochen,
besten Dank, aber FileDialog scheint nicht mit Excel 97 zu funktionieren.
Es erscheint immer die Fehlermeldung 'Benutzerdef. Typ nicht deklariert'.
Gruß
Stefan
Uups, stimmt! Gab's in xl97 noch nicht, sorry!
08.04.2010 09:32:58
JOWE
Aber so geht's auch mit xl97 (hoffe ich!!)
08.04.2010 10:21:05
JOWE
Private Declare

Function MyOpenFileName _
Lib "comdlg32.dll" Alias "GetOpenFileNameA" ( _
pOpenfilename As OPENFILENAME) As Long
Private Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
Flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type

Sub OpenTest()
Dim OFName As OPENFILENAME
OFName.lStructSize = Len(OFName)
OFName.lpstrFilter = "Dateien (130*.xls)" + Chr$(0) + "130*.xls" + Chr$(0)
OFName.lpstrFile = Space$(254)
OFName.nMaxFile = 255
OFName.lpstrFileTitle = Space$(254)
OFName.nMaxFileTitle = 255
OFName.lpstrInitialDir = "C:\temp\"
OFName.lpstrTitle = "Dateinamen merken "
OFName.Flags = 4
If MyOpenFileName(OFName) Then
MsgBox OFName.lpstrFile
End If
End Sub

Anzeige
AW: so aber:
08.04.2010 10:23:18
JOWE
Private Declare

Function MyOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As  _
OPENFILENAME) As Long
Private Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
Flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type

Sub OpenTest()
Dim OFName As OPENFILENAME
OFName.lStructSize = Len(OFName)
OFName.lpstrFilter = "Dateien (130*.xls)" + Chr$(0) + "130*.xls" + Chr$(0)
OFName.lpstrFile = Space$(254)
OFName.nMaxFile = 255
OFName.lpstrFileTitle = Space$(254)
OFName.nMaxFileTitle = 255
OFName.lpstrInitialDir = "C:\temp\"
OFName.lpstrTitle = "Dateinamen merken "
OFName.Flags = 4
If MyOpenFileName(OFName) Then
MsgBox OFName.lpstrFile
End If
End Sub

Anzeige
AW: so aber:
08.04.2010 12:25:22
Stefan
Hi Jochen,
Du gibst nicht auf, oder ? :-)
Leider stört sich meine Excelversion an dem 'Lib' in der ersten Zeile.
'Fehler beim kompilieren: Erwartet Anweisungsende'.
Was bedeutet das nun wieder ?
Besten Dank und Gruß
Stefan
AW: so aber:
08.04.2010 14:18:10
JoWE
Ich weis nicht warum das im Code weggeschniten ist, aber vor dem Wort Function muss zwingend noch
'Private Declare ' eingefügt werden. das steht über dem Code!
AW: so aber:
08.04.2010 14:59:36
Stefan
Jochen, Du bist der Größte !!!
Das funktioniert echt prima. Kann ich da noch irgendwie die Dateiendung abfragen (wg. den Wordfiles).
Ich habe es mit: If Right(OFName.lpstrFile, 3) = "doc" then ... versucht aber da spuckt Excel nichts aus.
Superlieben Dank dafür.
Gruß
Stefan K.
Anzeige
AW: so aber:
08.04.2010 16:26:05
fcs
Hallo Stefan,
in dem von der Function zurückgegebenen String mit dem Dateinamen stehen am Ende noch Leerzeichen und ein Sonderzeichen. Mit den folgenden Anpassungen wird der Dateiname isoliert und kann auf "doc" am Ende geprüft werden.
Gruß
Franz
Sub OpenTest()
Dim OFName As OPENFILENAME, sFile$
OFName.lStructSize = Len(OFName)
OFName.lpstrFilter = "Dateien (130*.doc)" & Chr$(0) & "130*.doc" & Chr$(0)
OFName.lpstrFile = Space$(254)
OFName.nMaxFile = 255
OFName.lpstrFileTitle = Space$(254)
OFName.nMaxFileTitle = 255
OFName.lpstrInitialDir = "C:\Lokale Daten\Test\"
OFName.lpstrTitle = "Dateinamen merken "
OFName.Flags = 4
If MyOpenFileName(OFName) Then
sFile = Trim(OFName.lpstrFile)
sFile = Left(sFile, Len(sFile) - 1)
If LCase(Right(sFile, 3)) = "doc" Then
MsgBox sFile
End If
End If
End Sub

Anzeige
AW: so aber:
09.04.2010 07:28:32
Stefan
Ihr seid echt Helden, funktioniert bestens (freu).
Ich bin jetzt anfang 40, aber ich glaube soviel kann ich gar nicht mehr lernen,
um das alles zu verstehen :-)
Ganz herzlichen Dank dafür. Das ist schon ein tolles Forum und es
scheint für (fast) alles immer eine Lösung zu geben.
Gruß und ein schönes Wochenende
Stefan K.

305 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige