VB and VBA Users Source Code: Delete all files in a directory that match a file pattern or last modified date
[
Home
|
Contents
|
Search
|
Reply
| Previous | Next ]
VB/VBA Source Code
Delete all files in a directory that match a file pattern or last modified date
By:
Andrew Baker
Email (spam proof):
Email the originator of this post
Date:
Friday, December 21, 2001
Hits:
932
Category:
Files/Directories/IO
Article:
The following code demonstrates how to delete/kill all the files in a specific directory which match either a file pattern or older than a specific date. 'Purpose : Deletes all the files in a directory which match the specified criteria 'Inputs : sDirectory The directory to delete this files in ' [sFilePattern] The file pattern to delete. eg. "*.xls" ' [dtModifiedOlderThan] If specified, deletes all files with a last ' modified date less than this date. ' [bDeleteInSubFolders] If true will delete matching files from any sub folders. 'Outputs : Returns the number of files deleted. 'Author : Andrew Baker 'Date : 08/01/2001 20:24 'Notes : If both parameters are specified then both have to be satified before the file will be deleted. ' Requires SCRRUN.DLL ("Microsoft Scripting Runtime") 'Revisions : Function FilesDelete(sDirectory As String, Optional sFilePatern As String, Optional dtModifiedOlderThan As Date, Optional bDeleteInSubFolders As Boolean = False) As Long Dim oFSO As Object 'Scripting.FileSystemObject Dim oDirectory As Object 'Scripting.Folder Dim oFolder As Object 'Scripting.Folder Dim oThisFile As Object 'Scripting.File Dim lCountDeleted As Long, bDeleted As Boolean On Error GoTo ErrFailed Set oFSO = CreateObject("Scripting.FileSystemObject") Set oDirectory = oFSO.GetFolder(sDirectory) If oFSO Is Nothing = True Or oDirectory Is Nothing = True Then Debug.Print "Scripting not installed!" Debug.Assert False FilesDelete = 0 Exit Function End If If bDeleteInSubFolders Then 'Delete matching files in sub directories For Each oFolder In oDirectory.SubFolders lCountDeleted = lCountDeleted + FilesDelete(oFolder.Path, sFilePatern, dtModifiedOlderThan, True) Next End If 'Loop through all the files in the directory For Each oThisFile In oDirectory.Files bDeleted = False If dtModifiedOlderThan Then 'Check file date If Len(sFilePatern) Then 'Check file name pattern and date If oThisFile.Name Like sFilePatern And oThisFile.DateLastModified < dtModifiedOlderThan Then 'Delete old file lCountDeleted = lCountDeleted + 1 oThisFile.Delete True bDeleted = True End If ElseIf oThisFile.DateLastModified < dtModifiedOlderThan Then 'Delete old file lCountDeleted = lCountDeleted + 1 oThisFile.Delete True bDeleted = True End If ElseIf oThisFile.Name Like sFilePatern Then 'Delete matching file lCountDeleted = lCountDeleted + 1 oThisFile.Delete True End If Next Set oThisFile = Nothing Set oDirectory = Nothing Set oFSO = Nothing 'Return the count of the files deleted FilesDelete = lCountDeleted Exit Function ErrFailed: Debug.Assert False Debug.Print "Error in FilesDelete: " & Err.Description FilesDelete = 0 Resume Next End Function Sub Test() Dim lCountDeleted As Long 'Delete all mdb files older than a 28 days (inc. any in the sub folders) lCountDeleted = FilesDelete("C:\Web\Support\database\archive", "*.mdb", Now - 28, true) Debug.Print "Deleted " & lCountDeleted & " files..." End Sub
Terms and Conditions
Support this site
Download a trial version of the Excel Workbook Rebuilder
