Platzhalter erkennen

[marose67]

Hallo zusammen,

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:

Microsoft Excel Objekt Tabelle6

Option Explicit 
 
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 
  Select Case LCase(FSO.getextensionname(strGef)) 
    Case strext 
    x = x + 1 
    ActiveSheet.Hyperlinks.Add Anchor:=Cells(x, 1), Address:= _
    strGef, TextToDisplay:=strGef.Name 
  End Select 
Next 
Application.ScreenUpdating = True 
End Sub 
 
 

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?

strext = InputBox("Nenne die Extension")

Gruß
Marcus

[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"

[marose67]

Hallo Jeremaia,

ist ja nach dem Punkt. xla, xls,xlsm,xlam,xlsx, xlt, xlsb
Ich suchte also nach xls*
Hier mal die Datei ...


  Dateinamen_auflisten_ab_2007.xls (Größe: 21,5 KB / Downloads: 1)
Gruß
Marcus

[JereMaia]

Frage:

Wie sieht es mit diesem Beispielcode für Dich aus? Wäre das das gewünschte Ergebnis für Dich?

Code:

Sub Dateinamen_auflisten()
On Error Resume Next
Dim strPfad As String
Dim x As Integer
Dim strtext As String
Dim a As String

'*** Suffix ************************************************
strtext = Trim(InputBox("Nenne die Extension"))
If (InStr(strtext, ".") = 0) Then strtext = "." & strtext

'*** Verzeichnis ******************************************
strPfad = Trim(InputBox("Geben Sie den Pfad ein"))
If (Right(strPfad, 1) <> "\") Then strPfad = strPfad & "\"


'*** Fielliste durchgehen ********************************
Application.ScreenUpdating = False
ActiveSheet.UsedRange.Clear
a = Dir(strPfad & "*" & strtext, vbNormal)



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.

[marose67]

Hallo Jeremaia,

der Code macht was ich will. Schaue ihn mir jetzt genauer an. Supi.

Gruß
Marcus

[schauan]

Hi Marcus,

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

[marose67]

Halo André,

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

[marose67]

Hallo,

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

Option Explicit 

Sub Dateinmen_auflisten() 
Dim x As Integer 
Dim y As Byte 
Dim strGef As Long 
Dim strPfad(3) As Variant 
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 = 1 To 3 
    With Application.FileSearch 
        .LookIn = strPfad(y) 
        .FileType = msoFileTypeExcelWorkbooks 
        .Execute 
        x = .FoundFiles.Count 
            For strGef = 1 To x 
                ActiveSheet.Hyperlinks.Add Anchor:=Cells(strGef + 2, y), Address:= _
                .FoundFiles(strGef), TextToDisplay:= _
                .FoundFiles(strGef) 
            Next 
    End With 
    Cells(2, y) = strPfad(y) & "  hat " & x & " Einträge" 
    With Worksheets("Break").Cells(2, y).Font 
        .Name = "Arial" 
        .Size = 12 
        .Bold = True 
        .Italic = True 
    End With 
Next 
Application.ScreenUpdating = True 
End Sub 

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

[schauan]

Hi Marcus,

kann es sein, dass es Application.Filesearch auch nicht mehr gibt?

korekt, ich glaube, das ist schon Jahre im zweistelligen Bereich her …

[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:

Option Explicit

Sub Dateinmen_auflisten()
Dim x As Integer
Dim y As Byte
Dim StrAnzahl As Variant
Dim strPfad(3) As Variant
Dim FSO As Object
Dim strGef As Object
Dim strext As String
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 = 1 To 3
        'x = .FoundFiles.Count 
        For StrAnzahl = 1 To x
            Set FSO = CreateObject("Scripting.FilesystemObject")
                For Each strGef In FSO.getfolder(strPfad(x)).Files
                    If LCase(FSO.getextensionname(strGef)) Like (strext) Then
        x = x + 1
    'Next 
'Next    'End With 
    
    Cells(2, y) = strPfad(y) & "  hat " & x & " Einträge"
    With Worksheets("Break").Cells(2, y).Font
        .Name = "Arial"
        .Size = 12
        .Bold = True
        '.Underline = xlUnderlineStyleSingle 
        .Italic = True
        
    End With
    
Next
Application.ScreenUpdating = True
End Sub

Bekomme ständig die Meldung Next ohne For.

Aber wie geschrieben ... ich finde das Problem noch.
Wünsche Dir ein schönes Wochenende. Grüße deine Frau auch von mir.



Gruß

Marcus