Dateien löschen: -Tag / Unterv. / txt

Bild

Betrifft: Dateien löschen: -Tag / Unterv. / txt
von: albin
Geschrieben am: 11.08.2015 22:34:56

Hallo zusammen
Habe leider kein brachbares Beispiel im Netz gefunden, dass ab Version 2010 läuft.
Wunsch: Bestimmte Dateien löschen, Optionen: älter als 30 Tag / Dateitype z.B. Txt und vor allem auch in allen Unterverzeichnissen.
Beispiel:
C:\temp\a\test.txt
C:\temp\a\1\test.txt
C:\temp\a\2\test.txt
C:\temp\a\3\test.txt
u.s.w
Das VBA sollte alle 4 Txt-Dateien löschen, wenn diese z.B. älter sind als 30 Tage
sind.
Ich danke Euch im Voraus.
Gruss Albin
Dieses VBA läuft zwar, aber berücksichtig leider die Unterverzeichnisse nicht.

Sub dateiloeschen()
Dim intZahl      '
Dim strExtension      '
Dim intTage           '
Dim objDatei          '
Dim objFSO            '
Dim objOrdner         '
Dim strOrdner         '
Set objFSO = CreateObject("Scripting.FileSystemObject")
strOrdner = ("c:\Temp\a")
strExtension = "txt"
intTage = 30
Set objOrdner = objFSO.GetFolder(strOrdner)
intZahl = 100000
For Each objDatei In objOrdner.Files
If LCase(Right(objDatei.Name, Len(strExtension))) = LCase(strExtension) And DateDiff("d",  _
objDatei.DateLastModified, Now) > intTage Then
objDatei.Delete
intZahl = intZahl + 1
End If
Next
End Sub

Bild

Betrifft: AW: Dateien löschen: -Tag / Unterv. / txt
von: Rudi Maintaire
Geschrieben am: 12.08.2015 09:56:56
Hallo,
ganz gefährlich, ohne Papierkorb!!!

Option Explicit
Sub DateienLoeschen()
  Dim FSO As Object, oFolder As Object, oDictF As Object, oD
   
  Const strExt As String = ".txt"
  Const intTage As Integer = 30
  Const strFolder As String = "c:\temp\a"
  
  Application.ScreenUpdating = False
      
  Set FSO = CreateObject("Scripting.FileSystemObject")
  Set oFolder = FSO.GetFolder(strFolder)
  Set oDictF = CreateObject("Scripting.dictionary")
  
  prcFiles oFolder, oDictF, strExt, intTage
  prcSubFolders oFolder, oDictF, strExt, intTage
  
  If oDictF.Count Then
    For Each oD In oDictF
      FSO.getfile(oD).Delete
    Next
  End If
  
End Sub
Sub prcFiles(oFolder, oDictF, strExt, intTage)
  Dim oFile As Object
  For Each oFile In oFolder.Files
    With oFile
    If LCase(Right(.Name, Len(strExt))) = LCase(strExt) And Date - .DateLastModified > intTage  _
Then
      oDictF(.Path) = 0
    End If
    End With
  Next
End Sub
Sub prcSubFolders(oFolder, oDictF, strExt, intTage)
  Dim oSubFolder As Object
  For Each oSubFolder In oFolder.SubFolders
    prcFiles oSubFolder, oDictF, strExt, intTage
    prcSubFolders oSubFolder, oDictF, strExt, intTage
  Next
End Sub

Gruß
Rudi

Bild

Betrifft: AW: Dateien löschen: -Tag / Unterv. / txt
von: Rudi Maintaire
Geschrieben am: 12.08.2015 09:57:07
Hallo,
ganz gefährlich, ohne Papierkorb!!!

Option Explicit
Sub DateienLoeschen()
  Dim FSO As Object, oFolder As Object, oDictF As Object, oD
   
  Const strExt As String = ".txt"
  Const intTage As Integer = 30
  Const strFolder As String = "c:\temp\a"
  
  Application.ScreenUpdating = False
      
  Set FSO = CreateObject("Scripting.FileSystemObject")
  Set oFolder = FSO.GetFolder(strFolder)
  Set oDictF = CreateObject("Scripting.dictionary")
  
  prcFiles oFolder, oDictF, strExt, intTage
  prcSubFolders oFolder, oDictF, strExt, intTage
  
  If oDictF.Count Then
    For Each oD In oDictF
      FSO.getfile(oD).Delete
    Next
  End If
  
End Sub
Sub prcFiles(oFolder, oDictF, strExt, intTage)
  Dim oFile As Object
  For Each oFile In oFolder.Files
    With oFile
    If LCase(Right(.Name, Len(strExt))) = LCase(strExt) And Date - .DateLastModified > intTage  _
Then
      oDictF(.Path) = 0
    End If
    End With
  Next
End Sub
Sub prcSubFolders(oFolder, oDictF, strExt, intTage)
  Dim oSubFolder As Object
  For Each oSubFolder In oFolder.SubFolders
    prcFiles oSubFolder, oDictF, strExt, intTage
    prcSubFolders oSubFolder, oDictF, strExt, intTage
  Next
End Sub

Gruß
Rudi

Bild

Betrifft: AW: Dateien löschen: -Tag / Unterv. / txt
von: albin
Geschrieben am: 12.08.2015 10:57:55
Super !!!!!
Das Teil passt 100%.
Vielen Dank an Rudi

 Bild

Beiträge aus den Excel-Beispielen zum Thema "Dateien löschen: -Tag / Unterv. / txt"