Sub ExeListen()
Worksheets.Add
Cells(1, 1) = "Dateiname"
Cells(1, 2) = "Erstelldatum"
Cells(1, 3) = "Pfad"
List "A:\", "*.exe"
List "B:\", "*.exe"
List "C:\", "*.exe"
List "D:\", "*.exe"
List "E:\", "*.exe"
With Range(Cells(1, 1), Cells(Rows.Count, 1).End(xlUp).Offset(0, 2))
.EntireColumn.AutoFit
.Sort Key1:=Range(Cells(1, 2), Cells(.Rows.Count, 2)), order1:=xlDescending, Header:=xlYes
End With
Application.StatusBar = False
MsgBox "Fertig!", vbInformation
End Sub
Private Sub List(Folder As String, Filetype As String)
Dim fs, f, s, Datei As String
Set fs = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
Application.StatusBar = "Ordner wird durchsucht: " & Folder
DoEvents
Datei = Dir(Folder & Filetype)
Do While Datei <> ""
If fs.GetFile(Folder & Datei).DateCreated >= Date - 30 Then
With Cells(Rows.Count, 1).End(xlUp)
.Offset(1, 0) = Datei
.Offset(1, 1) = fs.GetFile(Folder & Datei).DateCreated
.Offset(1, 2) = fs.GetFile(Folder & Datei).ParentFolder
End With
End If
Datei = Dir
Loop
For Each f In fs.getfolder(Folder).subfolders
List f.Path & "\", Filetype
Next f
End Sub