alle dat im Ordner löschen bis auf jüngste

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
MsgBox
Bild

Betrifft: alle dat im Ordner löschen bis auf jüngste von: ray
Geschrieben am: 17.02.2005 14:52:14

Hallo, mit folgendem code kann ich alle Dateien löschen, die älter als 30tage sind.

es fehlt mir jetzt folgende Bedingung:
Lösche alle dateien, die älter als 30 Tage sind und wenn alle älter als 30tage dann lösche alle bis auf die jüngste.

Hat jemand ne idee, wie ich das einbauen kann?

Grüße aus HH, schon ein bißchen heller...
ray


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

Bild


Betrifft: AW: alle dat im Ordner löschen bis auf jüngste von: Nepumuk
Geschrieben am: 17.02.2005 16:05:39

Hallo Ray,

lege einen benutzerdefinierten Datentyp mit zwei Einträgen an. Einen vom Typ String für den Dateipfad und einen vom Typ Date für das Datum. Nach der Execute - Methode steht die Anzahl der gefundenen Dateien fest. Damit kannst du ein Array mit dem Datentyp dimensionieren. Lies alle Dateien und deren Datum in das Array ein, und sortiere dieses nach aufsteigendem Datum. Dann machst du eine Schleife mit der Anzahl der gefundenen Dateien-1 auf. Dadurch bleibt die jüngste Datei garantiert erhalten. Du kannst dann in der Schleife deine ganz normale Prüfung laufen lassen und wenn alle Dateien älter als 30 Tage sind, werden alle bis auf die jüngste gelöscht. Alles klar?

Gruß
Nepumuk


Bild


Betrifft: AW: alle dat im Ordner löschen bis auf jüngste von: ray
Geschrieben am: 18.02.2005 08:02:32

Hi Nepumuk,

vielen Dank für Deinen Tip. Da ich noch nie Array benutzt habe, verstehe ich nur Bahnhof. Kannst Du mir ein Beispiel geben, was zu meinem Problem paßt?

Viele Grüße aus Hamburg, Schneegriesel und mäßig kalt.
ray


Bild


Betrifft: AW: alle dat im Ordner löschen bis auf jüngste von: Fred
Geschrieben am: 18.02.2005 12:44:24

VBA gut und kennst kein Array?

Fred


Bild


Betrifft: AW: alle dat im Ordner löschen bis auf jüngste von: ray
Geschrieben am: 21.02.2005 08:14:56

na, ja, es gibt schon VBASachen, die ich echt gut oder sehr gut kann. Nur array habe ich noch nicht gebracht. daher....


Bild


Betrifft: AW: alle dat im Ordner löschen bis auf jüngste von: Nepumuk
Geschrieben am: 18.02.2005 16:13:15

Hallo Ray,

außer, das du siehst, wie ich es machen würde, hast du aber nichts dabei gelernt.


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


Gruß
Nepumuk


Bild


Betrifft: AW: alle dat im Ordner löschen bis auf jüngste von: ray
Geschrieben am: 21.02.2005 08:20:00

Hi Nepumuk,
danke für den code. Ich lerne wie die Japaner am besten durch kopieren und verändern.

Danke, daß Du mir geholfen hast, ich chk den code.

Viele Grüße aus Hamburg, kalt und ungemütlich

ray


 Bild

Beiträge aus den Excel-Beispielen zum Thema "alle dat im Ordner löschen bis auf jüngste"