Hallo André,
Installierst du so viel, dass du nicht mehr weißt, welche Programme du in den letzten 30 Tagen hinzugefügt hast?
Mit dem folgenden Code sollte das möglich sein. Damit werden sämtliche Ordner durchsucht, wovon es auf dem Windowslaufwerk oft sehr viele gibt. Das kann also ein Weilchen dauern. Der jeweils aktuelle Ordner wird in der Statusleiste angezeigt. Wenn du darauf verzichtest, gehts wesentlich schneller, dauert aber immer noch lange. Schmeiß dazu Application.Statusbar sowie das nachfolgende DoEvents einfach wieder raus. Dann siehst du allerdings nicht mehr den aktuellen Fortschritt. Lass den PC einfach eine Weile in Ruhe arbeiten. Er meldet sich, wenn er fertig ist.
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
Gruß Mr. K.
|