Habe folgendes Makro das mir je nach eingabe der dateiendung die dateien sucht und sie dann auflistet in excel die gefundenen Dateien.
Folgendes möchte ich gerne erreichen.Bis jetzt geht es irgendwie nur mit der endung *.xls und *.txt
möchte mir aber gerne auch *.bmp oder *.exe auflisten lassen.
Ich hoffe ihr könnt mir helfen, vielen Dank Chris
Public ZellEnde, Zellnr
Sub Auto_open()
Sheets("Menü").Select
ActiveSheet.OnDoubleClick = "öffnen"
Range("A6").Select
End Sub
Sub öffnen()
On Error Resume Next
Aspalte = Selection.Column
Datei_name = ActiveCell
Workbooks.Open FileName:=Datei_name
End Sub
Sub dateien_lesen()
Set dateiSuche = Application.FileSearch
Dim i%
Dim LWs$, LW$
On Error Resume Next
For i = 97 To 122
Err.Clear
ChDrive Chr(i)
If Err = 0 Then
LWs = LWs & Chr(i) & ","
End If
Next i
LWs = Left(LWs, Len(LWs) - 1)
LW = InputBox("Geben Sie das zu durchsuchende Laufwerk an." & Chr(13) & " " & Chr(13) _
& "Mögliche Buchstaben sind " & LWs & ".", "Eingabe Laufwerksbuchstabe")
If LW = "" Then Exit Sub
Call Rahmen_löschen
Application.ScreenUpdating = True
su = InputBox("Geben sie die Endung ein nach der sie suchen wollen !")
Sheets("warten").Select
Range("D7") = UCase(LW)
Application.ScreenUpdating = False
With dateiSuche
.LookIn = LW & ":\"
.SearchSubFolders = True
.FileName = "*." & su
If .Execute() > 0 Then
For i = 1 To .FoundFiles.Count
Worksheets("Menü").Cells(i + 5, 1).Value = .FoundFiles(i)
Next i
Else
Application.ScreenUpdating = True
Sheets("Menü").Select
Range("A6").Select
Selection.ColumnWidth = 40
MsgBox "Es wurden keine Dateien gefunden.", vbInformation, "Suche ohne Ergebnis"
Exit Sub
End If
End With
Call Rahmen_ziehen
End Sub
Sub Rahmen_ziehen()
Sheets("Menü").Select
Application.ScreenUpdating = False
ZellEnde = Range("A" & Rows.Count).End(xlUp).Row
Range("A6:A" & ZellEnde).Select
Selection.Columns.AutoFit
If Selection.ColumnWidth < 44 Then Selection.ColumnWidth = 45
Selection.Borders(xlLeft).Weight = xlThin
Selection.Borders(xlRight).Weight = xlThin
Selection.Borders(xlBottom).Weight = xlHairline
Range("A4") = ZellEnde - 5 & " Datei(en) gefunden"
Range("A6").Select
End Sub
Sub Rahmen_löschen()
Application.ScreenUpdating = False
Range("A4") = " "
ZellEnde = Range("A" & Rows.Count).End(xlUp).Row
Range("A6:A" & ZellEnde + 7).Select
Range("A6:A" & ZellEnde).Select
Selection.Borders(xlLeft).LineStyle = xlNone
Selection.Borders(xlRight).LineStyle = xlNone
Selection.Borders(xlBottom).LineStyle = xlNone
Range("A6:A" & ZellEnde).ClearContents
Range("A6").Select
End Sub