Effacer les fichiers anciens

Public function DeleteOlderFiles (ByVal FoldersToProcess, ByVal MaxDayAge, ByVal Extension, ByVal DebugMode)

	'25 january 2010 version 'Add debug mode
	'3 december 2009 version
	'Use to delete files with a specific extension older than ...
	'Parameters :
	'
	FoldersToProcess : all folders to process separated by ;
	'
	MaxDayAge : All files older than xx days will be deleted
	'
	Extension : file extension to process. All other file extension are not concerned

	'Example 1 :
	'
	Call DeleteOlderFiles("D:\", 6, "txt")

	'Example 1 :
	'
	Call DeleteOlderFiles("D:\;C:\Temp", 6, "log")

	Dim FolderArray
	Dim FolderPath

	Dim objFSO
	Dim ObjFolder
	Dim ObjFile
	Dim FileAge

	Dim ErrorNumber

	If DebugMode = 1 Then
		Wscript.echo "DeleteOlderFiles() function"
	End If

	Set objFSO = CreateObject("Scripting.FileSystemObject")

	FolderArray = Split(FoldersToProcess, ";")
	For Each FolderPath In FolderArray
		If objFSO.FolderExists(FolderPath) Then
			If DebugMode = 1 Then
				Wscript.echo "Process " & FolderPath & " folder"
			End If

			Set ObjFolder = objFSO.GetFolder(FolderPath)
			For Each ObjFile In ObjFolder.Files
				'Wscript.echo "File " & ObjFile.Name
				If ExtensionFichier(ObjFile.Name) = Extension Then
					FileAge = DateDiff("d", ObjFile.DateCreated, Now())
					If DebugMode = 1 Then
						Wscript.echo "File " & ObjFile.Name & " have " & FileAge & " day(s)"
					End If

					If FileAge > MaxDayAge Then
						If DebugMode = 1 Then
							Wscript.echo "Deleting " & ObjFile.Name
						End If

						Err.Clear
						On Error Resume Next
						Call objFSO.DeleteFile(objFile.Path)
						ErrorNumber = Err.Number
						On Error goto 0

						Select Case NumeroErreur
						Case 0
							If DebugMode = 1 Then
								Wscript.echo "Done"
							End If
						Case Else
							Wscript.echo "Error for deleting file : " & Err.Description
						End Select
					End If
				End If 'If ExtensionFichier(ObjFile.Name) = "bak" Then
			Next

			Set ObjFolder = Nothing
		Else
			Wscript.echo "Folder " & FolderPath & " dont exist"
		End If
	Next

	Set objFSO = Nothing
End Function

Public Function ExtensionFichier(ByVal CheminFichier)

	'Retourne l'extension du fichier
	Dim Position
	ExtensionFichier = ""

	Position = InStrRev(CheminFichier,".")

	If (Position > 0) And (Position < Len(CheminFichier)) Then
		ExtensionFichier = Mid(CheminFichier,Position+1)
		ExtensionFichier = Lcase(ExtensionFichier)
	End If

End Function