Home

1 1 1 1 1 1 1 1 1 1 Rating 5.00 (1 Vote)
 Problemstellung:

Manchmal ist es erforderlich alte Dateien zu löschen, egal ob es alte Import-, Sicherungsdateien o.ä. sind.
Jetzt möchte man aber die zu löschenden Dateien einschränken, ob nun nach Dateinamen und/oder Dateidatum,
mit Unterverzeichnissen oder ohne.

Für dieses Problem möchte ich hier eine Lösung vorstellen.

Es ist eine Mischung aus FileSystemObject(FSO)- und API-Funktionen.

1. API-Aufrufe zum Löschen der Dateien

Hier kommt die API-Funktion "SHFileOperation" zum Einsatz

1.1. Declare- und Konstantendeklaration

Nur für 32Bit Office Versionen

Private Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" ( _
ByRef lpFileOp As SHFILEOPSTRUCT) As Long
Private Type SHFILEOPSTRUCT
   hWnd As Long
   wFunc As Long
   pFrom As String
   pTo As String
   fFlags As Integer
   fAnyOperationsAborted As Long
   hNameMappings As Long
   lpszProgressTitle As String
End Type
Private Const FO_DELETE = &H3&
Private Const FOF_ALLOWUNDO = &H40&
Private Const FOF_NOCONFIRMATION = &H10

Wobei die Konstante

Private Const FOF_ALLOWUNDO = &H40&

dafür zuständig ist das die gelöschten Dateien im Papierkorb landen

und die Konstante

Private Const FOF_NOCONFIRMATION = &H10&

die Bestätigung jeder Dateilöschung deaktiviert.

Dies rufen wir dann in dieser Sub auf:

1.2. Dateien in den Papierkorb löschen

Private Sub Delete_to_Trash(sFilename As String)
   Dim udtFileStructure As SHFILEOPSTRUCT
   With udtFileStructure
     .wFunc = FO_DELETE
     .pFrom = sFilename
     .fFlags = FOF_ALLOWUNDO Or FOF_NOCONFIRMATION
   End With
   SHFileOperation udtFileStructure
End Sub

 

2. Lesen der Dateien mit FSO, prüfen der Kriterien und löschen der Dateien

Für 32Bit und 64Bit Office Versionen

Die folgende Sub macht dann die eigentliche Arbeit

Public Sub DeleteCriteriaFiles(sPath As String, Optional sCriteria As String = "*.*", _
                               Optional dtCriteriaDate As String = "", _
                               Optional bSubFolder As Boolean = False)
    Dim oFSO As New FileSystemObject
    Dim oFolder As Folder
    Dim oSubFolders As Object, oSubFolder As Folder
    Dim oFile As File
    Set oFolder = oFSO.GetFolder(sPath)
    For Each oFile In oFolder.Files
        If oFile.Name Like sCriteria = True Then
            If dtCriteriaDate <> "" Then
                'Datumskriterium vorhanden
                If CDate(Left(oFile.DateLastModified, 10)) <= CDate(dtCriteriaDate) Then Delete_to_Trash oFile.Path
            Else
                'Datumskriterium nicht vorhanden
                Delete_to_Trash oFile.Path
            End If
        End If
    Next oFile
    'Unterverzeichnisse einbeziehen
    If bSubFolder = True Then
        Set oSubFolders = oFolder.SubFolders
        For Each oSubFolder In oSubFolders
            DeleteCriteriaFiles oSubFolder.Path, sCriteria, dtCriteriaDate, bSubFolder
        Next oSubFolder
    End If
    Set oFile = Nothing: Set oSubFolders = Nothing
    Set oFolder = Nothing: Set oSubFolder = Nothing
    Set oFSO = Nothing
End Sub

Folgende Parameter werden der Prozedur übergeben:

sPath As String

Der komplette Pfad des betreffenden Verzeichnisses mit abschliessenden Backslash

Optional sCriteria As String = "*.*" 

Das Filterkriterium für die Dateinamen, Standard = Alle (*.*)

Optional dtCriteriaDate As String = "" 

Das Filterkriterium für das Dateidatum Standard = Kein ("")
Bei einer Angabe eines Datums werden alle Dateien deren letztes Änderungsdatum <= dem Kriterium entspricht gelöscht.
Wird etwas anderes gewünscht muss diese Zeile angepasst werden:

If CDate(Left(oFile.DateLastModified, 10)) <= CDate(dtCriteriaDate) Then Delete_to_Trash oFile.Path
Optional bSubFolder As Boolean = False

Sollen Unterverzeichnisse einbezogen werden? Standard = Nein (False)
 
Der Aufruf z.B.:

DeleteCriteriaFiles "D:\users\Test0\", "*.txt", "01.09.2010", True 
 
Würde aus dem Verzeichnis "D:\Users\Test0", mit Unterverzeichnissen, alle txt-Dateien löschen deren letztes Änderungsdatum
kleiner gleich dem 01.09.2010 ist.
 

 

Ähnliche Artikel

You have no rights to post comments

Login Form

Neueste Artikel

SQL zu VBA Konverter
26. Oktober 2018
Problemstellung: Nur für 32Bit Office Versionen Gibt es eine Möglichkeit SQL-Code einer Abfrage so zu konvertieren das der Code in VBA genutzt werden kann? Lösung: Bis Access 2010 gibt das Tool...
1.png5.png7.png8.png8.png7.png6.png
Heute394
Gestern271
Diese Woche1225
Dieser Monat7499
Total1578876

  • IP: 107.21.176.63
  • Browser: Unknown
  • Version:
  • OS: Unknown

Online

3
Online

28. März 2024

Letzte Kommentare

  • Berechnen von Zeiträumen als Abfragekriterium

    elmard 02.02.2021 21:02
    1000 Dank
    für diese Datenbankanwendung! Eine sehr gute Umsetzung mit den vielen Möglichkeiten des Datums.

    Weiterlesen...

     
  • SQL zu VBA Konverter

    Tommy Admin 03.11.2019 16:33
    RE: SQL zu VBA Konverter
    Hallo Elmard, danke für die Info. :lol:

    Weiterlesen...

     
  • SQL zu VBA Konverter

    elmard 03.11.2019 14:49
    Bei SmartTools neue Version 4.0
    Dieses Tool liegt inzwischen in der Version 4 vor und läuft nun auch von A2013 und A2016 sowie im ...

    Weiterlesen...

     
  • Workshop zur Benutzung des Multi-Column TreeView Control unter MS-Access

    TommyK 27.02.2019 06:52
    Workshop
    Hallo mpegjunkie, danke für Dein Feedback. Schön das Dir Workshop weiter hilft. :D

    Weiterlesen...

     
  • Workshop zur Benutzung des Multi-Column TreeView Control unter MS-Access

    mpegjunkie 26.02.2019 20:10
    Perfekter Workshop
    Hallo Tommy, perfekter Workshop, toll und umfassend erläutert. Jetzt nutze ich diese Controls auch.

    Weiterlesen...