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

Private Const FOF_ALLOWUNDO = &H40&

Private Const FOF_NOCONFIRMATION = &H10&

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

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

sPath As String

Optional sCriteria As String = "*.*" 

Optional dtCriteriaDate As String = "" 

• Versenden von E-Mails mit Dateianhängen mittels CDO-Message Library
• Suchen und Einlesen von Dateien mit MS-Access II
• Ermitteln und Beenden von externen Programmen
• Arbeiten mit EXIF-Tags
• Verzeichnisgröße ermitteln, wahlweise mit oder ohne Unterverzeichnisse