ich durchstöbere mal wieder meine alten Excel Files. Dort habe ich ein Makro gefunden, welches mir eine Auflistung von Files erstellt und diese als Hyperlink auswirft. Nun habe ich versucht dass mir alle Excel Files angezeigt werden. Da ich auch viele alte Files (xls, xla usw.) habe dachte ich mir, dass ich doch mal eben einen Platzhalter "*" mit eingeben könnte um alle Files anzuzeigen. Pustekuchen.
Hier mal der komplette Code:
Zitat:Microsoft Excel Objekt Tabelle6
OptionExplicitSub Dateinamen_auflisten()
Dim FSO AsObjectDim strPfad AsStringDim x AsIntegerDim strGef AsObjectDim strext AsString
strext = InputBox("Nenne die Extension")
Application.ScreenUpdating = False
strPfad = InputBox("Geben Sie den Pfad ein")
ActiveSheet.UsedRange.Clear
Set FSO = CreateObject("Scripting.FilesystemObject")
ForEach strGef In FSO.getfolder(strPfad).Files
SelectCase LCase(FSO.getextensionname(strGef))
Case strext
x = x + 1
ActiveSheet.Hyperlinks.Add Anchor:=Cells(x, 1), Address:= _
strGef, TextToDisplay:=strGef.Name
EndSelectNext
Application.ScreenUpdating = TrueEndSub
Da ich eventuell auch nur nach *.xlsm suchen werde kann ich somit nicht die Endungen festlegen. Diese Zele erkennt scheinbar das "*"chen nicht weiter geben. Gibt es da vielleicht eine Möglichkeit?
Zitat:strext = InputBox("Nenne die Extension")
Gruß
Marcus
Wissen ist Macht - es ist aber nicht schlimm nicht alles zu wissen.
Man muss nicht alles wissen - man muss nur wissen wo es steht, oder wo man Hilfe bekommt.
05.02.2020, 13:25 (Dieser Beitrag wurde zuletzt bearbeitet: 05.02.2020, 13:25 von JereMaia.)
Ich kann mir denken warum das nicht funktioniert. Der Befehl
FSO.getfolder(strPfad).Files
Holt Dir alle Dateinamen. Per "FOR Echo"-Schleife gehst Du alle Dateinamen durch und prüfst "NUR" das Suffix ab (Extension).
Die Idee *.xlsm einzugeben wird so nicht hinhauen, da das * sich auf den Dateinamen bezieht.
Select Case LCase(FSO.getextensionname(strGef))
Diese Zeile prüft ja nur alles ab was NACH dem Punkt kommt. Ich beziehe mich mit dieser Aussage auf Dein Beispiel "*.xlsm"
--- Seid nett und helft einander :100: ---
--- denn die Liebe ist die größte Kraft im Universum ---
- Lest die Werke von Jakob Lorber und Gottfried Mayerhofer -
Wissen ist Macht - es ist aber nicht schlimm nicht alles zu wissen.
Man muss nicht alles wissen - man muss nur wissen wo es steht, oder wo man Hilfe bekommt.
Do While (a <> "")
x = x + 1
ActiveSheet.Hyperlinks.Add Anchor:=Cells(x, 1), Address:=a, TextToDisplay:=a
a = Dir()
Loop
Application.ScreenUpdating = True
End Sub
Gerade geprüft:
Wenn ich bei der ersten Abfrage für die Extension xls* eingebe und dann den gewünschten Pfad
Erhalte ich tatsächlich alle Excelfiles die in der Extension mindestens die Zeichenfolge xls enthalten.
--- Seid nett und helft einander :100: ---
--- denn die Liebe ist die größte Kraft im Universum ---
- Lest die Werke von Jakob Lorber und Gottfried Mayerhofer -
Folgende(r) 1 Nutzer sagt Danke an JereMaia für diesen Beitrag:1 Nutzer sagt Danke an JereMaia für diesen Beitrag 28 • marose67
der Code macht was ich will. Schaue ihn mir jetzt genauer an. Supi.
Gruß
Marcus
Wissen ist Macht - es ist aber nicht schlimm nicht alles zu wissen.
Man muss nicht alles wissen - man muss nur wissen wo es steht, oder wo man Hilfe bekommt.
hier mal Dein ursprünglicher Code mit einer entsprechenden Änderung - If … und Like statt Select Case. Du solltest dann eventuell noch den strext mit LCase behandeln...
Code:
Sub Dateinamen_auflisten()
Dim FSO As Object
Dim strPfad As String
Dim x As Integer
Dim strGef As Object
Dim strext As String
strext = InputBox("Nenne die Extension")
Application.ScreenUpdating = False
strPfad = InputBox("Geben Sie den Pfad ein")
ActiveSheet.UsedRange.Clear
Set FSO = CreateObject("Scripting.FilesystemObject")
For Each strGef In FSO.getfolder(strPfad).Files
If LCase(FSO.getextensionname(strGef)) Like (strext) Then
x = x + 1
ActiveSheet.Hyperlinks.Add Anchor:=Cells(x, 1), Address:= _
strGef, TextToDisplay:=strGef.Name
End If
Next
Application.ScreenUpdating = True
End Sub
. \\\|/// Hoffe, geholfen zu haben. ( ô ô ) Grüße, André aus G in T ooO-(_)-Ooo (Excel 97-2019+365)
Folgende(r) 1 Nutzer sagt Danke an schauan für diesen Beitrag:1 Nutzer sagt Danke an schauan für diesen Beitrag 28 • marose67
habe mir deinen Code kurz angeschaut. Viel hast Du ja nicht ändern müssen. Werde mich jetzt in den Code vertiefen, damit ich ihn begreife. Danke Dir auf alle Fälle.
Gruß
Marcus
Wissen ist Macht - es ist aber nicht schlimm nicht alles zu wissen.
Man muss nicht alles wissen - man muss nur wissen wo es steht, oder wo man Hilfe bekommt.
kann es sein, dass es Application.Filesearch auch nicht mehr gibt? Ich versuche die ganze Zeit euere Codes auf eine dritte Tabelle abzuändern. Schaffe ich aber nicht. Die Änderungen lösche ich immer ... fange von vorne an ... Der damalige Code:
Microsoft Excel Objekt Tabelle6
OptionExplicit
Sub Dateinmen_auflisten() Dim x AsInteger Dim y AsByte Dim strGef AsLong Dim strPfad(3) AsVariant
strPfad(1) = "C:\02_Excel\06_Excel_allgemein\"
strPfad(2) = "C:\02_Excel\07_Forumsarbeiten\"
strPfad(3) = "c:\100_Test\"
y = 1
Application.ScreenUpdating = False
UsedRange.Clear For y = 1To3 With Application.FileSearch
.LookIn = strPfad(y)
.FileType = msoFileTypeExcelWorkbooks
.Execute
x = .FoundFiles.Count For strGef = 1To x
ActiveSheet.Hyperlinks.Add Anchor:=Cells(strGef + 2, y), Address:= _
.FoundFiles(strGef), TextToDisplay:= _
.FoundFiles(strGef) Next EndWith
Cells(2, y) = strPfad(y) & " hat " & x & " Einträge" With Worksheets("Break").Cells(2, y).Font
.Name = "Arial"
.Size = 12
.Bold = True
.Italic = True EndWith Next
Application.ScreenUpdating = True EndSub
Mit dieser Tabelle hätte ich gerne einen schnelleren Zugriff auf meine Excel Beispiel. Mit Steuerung F könnte ich dann alles Suchen. Es hat sich ja soviel geändert ... Ich hänge die Datei auch an.
Gruß
Marcus
Wissen ist Macht - es ist aber nicht schlimm nicht alles zu wissen.
Man muss nicht alles wissen - man muss nur wissen wo es steht, oder wo man Hilfe bekommt.
08.02.2020, 10:33 (Dieser Beitrag wurde zuletzt bearbeitet: 08.02.2020, 11:12 von marose67.)
Hallo André,
naja ... weiß ich jetzt Bescheid. Ich bekomme das noch hin. Muss wirklich viel neues lernen.
Zur Zeit sieht der Code so aus:
Zitat:
OptionExplicit
Sub Dateinmen_auflisten() Dim x AsInteger Dim y AsByte Dim StrAnzahl AsVariant Dim strPfad(3) AsVariant Dim FSO AsObject Dim strGef AsObject Dim strext AsString
strPfad(1) = "C:\02_Excel\06_Excel_allgemein\"
strPfad(2) = "C:\02_Excel\07_Forumsarbeiten\"
strPfad(3) = "c:\100_Test\"
y = 1
Application.ScreenUpdating = False
UsedRange.Clear For x = 1To3 'x = .FoundFiles.Count For StrAnzahl = 1To x Set FSO = CreateObject("Scripting.FilesystemObject") ForEach strGef In FSO.getfolder(strPfad(x)).Files If LCase(FSO.getextensionname(strGef)) Like (strext) Then
x = x + 1 'Next 'Next 'End With
Aber wie geschrieben ... ich finde das Problem noch.
Wünsche Dir ein schönes Wochenende. Grüße deine Frau auch von mir.
Gruß
Marcus
Wissen ist Macht - es ist aber nicht schlimm nicht alles zu wissen.
Man muss nicht alles wissen - man muss nur wissen wo es steht, oder wo man Hilfe bekommt.