Sub filesCount()
Application.ScreenUpdating = False
Set fs = Application.FileSearch
inp1 = "D:\backup\mitder\"
With fs
.LookIn = inp1
.SearchSubFolders = False
.Filename = "*.xls"
If .Execute > 0 Then
If .FoundFiles.Count > 50 Then
'wenn mehr als 50,alle Dateien löschen,die älter als 30Tag
Dim sPath As String
Dim iCount As Integer, iCounter As Integer
sPath = inp1
iCount = 30
With Application.FileSearch
.LookIn = sPath
.Filename = "*.xls"
.Execute
For iCounter = 1 To .FoundFiles.Count
If FileDateTime(.FoundFiles(iCounter)) + 30 < Date _
Then
Kill .FoundFiles(iCounter)
End If
Next iCounter
End With
Else: MsgBox ""
End If
Else
MsgBox "Schwerer Fehler! Es wurde keine Dateien gefunden!!!", , Nofile = 1
End If
End With
If Nofile = 1 Then Exit Sub
End Sub
Option Explicit
Private Type Filedata
datLastUpdate As Date
strFilePath As String
End Type
Public Sub prcDelete_Old_Files()
Dim lngIndex1 As Long, lngIndex2 As Long
With Application.FileSearch
.NewSearch
.FileType = 4
.LookIn = "D:\backup\mitder\"
If .Execute > 0 Then
ReDim FileArray(1 To .FoundFiles.Count) As Filedata
For lngIndex1 = 1 To .FoundFiles.Count
FileArray(lngIndex1).strFilePath = .FoundFiles(lngIndex1)
FileArray(lngIndex1).datLastUpdate = FileDateTime(.FoundFiles(lngIndex1))
Next
Call sortieren(1, lngIndex1 - 1, FileArray())
For lngIndex2 = 1 To lngIndex1 - 2
If FileArray(lngIndex2).datLastUpdate + 30 < Date Then Kill FileArray(lngIndex2).strFilePath
Next
Else
MsgBox "Schwerer Fehler! Es wurde keine Dateien gefunden!!!", 16, "Fehlermeldung"
End If
End With
End Sub
Private Sub sortieren(lngUGrenze As Long, lngOGrenze As Long, FileArray() As Filedata)
Dim lngIndex1 As Long, lngIndex2 As Long, typElement As Filedata, datTemp As Date
lngIndex1 = lngUGrenze
lngIndex2 = lngOGrenze
datTemp = FileArray(Fix((lngUGrenze + lngOGrenze) / 2)).datLastUpdate
Do
Do While FileArray(lngIndex1).datLastUpdate < datTemp
lngIndex1 = lngIndex1 + 1
Loop
Do While datTemp < FileArray(lngIndex2).datLastUpdate
lngIndex2 = lngIndex2 - 1
Loop
If lngIndex1 <= lngIndex2 Then
typElement = FileArray(lngIndex1)
FileArray(lngIndex1) = FileArray(lngIndex2)
FileArray(lngIndex2) = typElement
lngIndex1 = lngIndex1 + 1
lngIndex2 = lngIndex2 - 1
End If
Loop Until lngIndex1 > lngIndex2
If lngUGrenze < lngIndex2 Then Call sortieren(lngUGrenze, lngIndex2, FileArray())
If lngIndex1 < lngOGrenze Then Call sortieren(lngIndex1, lngOGrenze, FileArray())
End Sub