Files and Folders

[Stevie]

Can anybody give me a pointer on how to go about, deleteing all files in a specified folder, older than a specified date.

Any ideas appreciated.

Public Function DeleteOldFiles(DaysOld As Long, FileSpec As _
String,Optional ComparisonDate As Variant) As Boolean

'PURPOSE: DELETES ALL FILES THAT ARE DaysOld Older than
'ComparisonDate, which defaults to now

'RETURNS: True, if succesful
'False otherwise (e.g., user passes non-date argument
'deletion fails because file is in use,
'file doesn't exist, etc.)

'will not delete readonly, hidden or system files

Dim sFileSpec As String
Dim dCompDate As Date
Dim sFileName As String
Dim sFileSplit() As String
Dim iCtr As Integer, iCount As Integer
Dim sDir As String

sFileSpec = FileSpec

If IsMissing(ComparisonDate) Then
    dCompDate = Now
ElseIf Not IsDate(ComparisonDate) Then
    'client passed wrong type
    DeleteOldFiles = False
    Exit Function
Else
    dCompDate = CDate(Format(ComparisonDate, "mm/dd/yyyy"))
End If

sFileName = Dir(sFileSpec)

If sFileName = "" Then
    'returns false is file doesn't exist
    DeleteOldFiles = False
    Exit Function
End If

Do

    If sFileName = "" Then Exit Do

    If InStr(sFileSpec, "\") > 0 Then
        sFileSplit = Split(sFileSpec, "\")
        iCount = UBound(sFileSplit) - 1
        For iCtr = 0 To iCount
            sDir = sDir & sFileSplit(iCtr) & "\"
        Next

        sFileName = sDir & sFileName
    End If

    On Error GoTo errhandler:
    If DateDiff("d", FileDateTime(sFileName), dCompDate) _
       >= DaysOld Then

         Kill sFileName

    End If

    sFileName = Dir
    sDir = ""
Loop

DeleteOldFiles = True

Exit Function

errhandler:
    DeleteOldFiles = False
    Exit Function
End Function

[seaweed]

To use this code you must go to Project/References... and select "Microsoft Scripting Runtime".

This is an example of how to delete all files in a folder using the Last Modified date. You can also check the Created date or the Last Accessed date. These are intrinsic properties of the File object.

I haven't actually run this, so there may be a bug or two, but it looks good from here...

Paste this into a Module (no need for a Form):

Option Explicit

' You must reference "Microsoft Scripting Runtime" to use the FileSystemObject\

Private Sub Main()
    Dim lsFolderPath As String
    Dim lsOlderThan As String
    
    lsFolderPath = InputBox("Enter the path of the folder you wish to delete files from:")
    lsOlderThan = InputBox("Enter a date to be used as a filter for deleting files from" & _
        vbNewLine & "the folder: " & lsFolderPath & vbNewLine & vbNewLine & "(All files " & _
        "modified on this date or before will be deleted)")
    
    ' Of course you would do data validation to make sure folder exists and date is a valid
    ' date and is equal to or earlier than today.  This is just a sample program.
    
    Call DeleteFiles(lsFolderPath, lsOlderThan)
    
    MsgBox "Done"
End Sub

Private Sub DeleteFiles(asFolderPath As String, asOlderThan As String)
    Dim loFileSys As FileSystemObject
    Dim loFolder As Folder
    Dim loFile As File
    
    Set loFileSys = New FileSystemObject
    Set loFolder = loFileSys.GetFolder(lsFolderPath)
    
    For Each loFile In loFolder.Files
        If loFile.DateLastModified <= CDate(asOlderThan) Then
            loFile.Delete
        End If
    Next ' loFile

    Set loFolder = Nothing
    Set loFileSys = Nothing
End Sub

[Edited by seaweed on 06-23-2000 at 01:38 PM]

[Stevie]

Thanks for both your answers, I was thinking along Seaweed's lines myself.

Thanks again.