Sub Suppe
Set objFileSearch = Application.FileSearch
With objFileSearch
.NewSearch
.LookIn = DirToSearch
.FileType = msoFileTypeAllFiles
.SearchSubFolders = True
'.Filename = FileToSearch & ".*"
.Filename = FileToSearch & ".avi"
If .Execute() > 0 Then
'MsgBox "There were " & .FoundFiles.Count & " file(s) found."
Cells(1, 1).Value = .FoundFiles.Count
Cells(1, 1).Name = "ItemFiles"
For i = 2 To .FoundFiles.Count
'MsgBox .FoundFiles(i)
Cells(i, 1).Value = i
Cells(i, 2).Value = .FoundFiles(i)
Next i
Else
MsgBox "There were no files found."
End If
End With
End Sub
OK?
Franz D.
OK?
Nö.
DirToSearch ist nicht definiert,
VBA gut?
Schon mal was von Option Explicit gehört?
Gruß
Rudi
.Filename = "*.*"
Es werden alle Dateien gefunden.
Im weiteren Code, filterst Du die Dateien z. Bsp. mit dem Like Operator.
If (LCase(.FoundFiles(i)) Like "*.jpg") Or (LCase(.FoundFiles(i)) Like "*.mpg") Then
'Dein andere Code
End If
Kann es leider nicht testen, habe hier xl2007 und da gibt es FileSearch nicht mehr.
Gruß Tino
Sub Struppi_such()
Sheets.Add
Call Dateien_vom_Typ_suchen("C:", "*.avi")
Sheets.Add
Call Dateien_vom_Typ_suchen("C:", "*.mpg")
End Sub
Sub Dateien_vom_Typ_suchen(DirToSearch As String, FileToSearch As String)
Dim i As Integer
Dim objFileSearch As FileSearch
Set objFileSearch = Application.FileSearch
With objFileSearch
.NewSearch
.LookIn = DirToSearch
.FileType = msoFileTypeAllFiles
.SearchSubFolders = True
.Filename = FileToSearch
If .Execute() > 0 Then
Cells(1, 1).Value = .FoundFiles.Count
For i = 2 To .FoundFiles.Count
Cells(i, 1).Value = .FoundFiles(i)
Next i
Else
MsgBox "There were no files found."
End If
End With
End Sub
Das Problem liegt daran dass die "Vorgänger"-Treffer immer wieder überschrieben werden je nach neuem Attribut. Habe auch nach einer "Pipe"-Lösung gesucht (ähnlich wie "|*.avi|*.mpg|) wie sie in mancher VB-Literatur zu finden ist. Nochmals Danke schön Tino. Kann man meine "Lösung" eventuell optimieren?
MfG
Franz D.