EFFACER FICHIER/DOSSIERS EN FONCTION DE LEUR DERNIERE DATE DE MODIFICATION.

on error resume next
'declaration des variables
Dim folder
dim Subfolder
dim path
Dim FSO
Dim B
'instantation du file system object (FSO)
Set FSO = CreateObject("Scripting.FileSystemObject")

'initialisation de la variable contenant le chemin du repertoire racine
path = "D:\test_transit\Transit"

'appel de la fonction recurcive avec comme argument le chemin du repertoire
'racine
recurcive path

function recurcive(chemin) 'fonction récurcive pour traiter tout l'arboresence
                           'des dossiers

set folder = FSO.GetFolder (chemin) 'utilisation du FSO pour prendre le dossier
                                    'racine
set Subfolder = folder.SubFolders   'definition de la varibale pour les S/dossiers

for each A in Subfolder 'pour chaque dossier dans le sous dossier racine
        Set fic = A.Files 'definition de la variables toucher les fichier des dossier

        fichier fic 'appel de la fontion fixhier
        recurcive A 're-appel de la fonction recurcive pour traiter les S/dossiers
        
next
end function 'fin de la fonction


function fichier(fic) 'fonction qui traite les fichiers dans les dossiers A

For Each objFile in fic 'pour chaque fichier dans dossiers de fichier
        Set f = fso.GetFile(objfile) 'utilisation du FSO pour prendre le fichier
            If DateDiff("D", objfile.DateLastModified, now) > 10 Then 'si la derniére modification du fichier est plus ancienne que X jours
            msgbox objfile & " a suprimer" 'alors effacer le fichier avec option de forcer pour les fichier en lecture seule
            'FSO.DeleteFile f, force = yes
            end if 'fin du SI
    next
    
end function 'fin de la fonction

Set fic = folder.Files
fichier fic

       set folder = FSO.GetFolder (path)'utilisation du FSO pour prendre le dossier
       For Each B in folder.subfolders 'pour chaque dossier dans le dossier racine
                If B.size = 0 Then 'si la taille du dossier est egal a 0 (donc vide)
                 msgbox B & B.size 'effacer le dossier
                 'FSO.DeleteFolder B, force = yes
                End If 'fin du SI
		
        Next
        

14 décembre 2006 09:41:46 :

1 - rajout d'un commentaire

14 décembre 2006 11:05:27 :

2 - mis e ajour de variables

14 décembre 2006 14:13:31 :

3 - mise a jour pour etre mis en production

04 avril 2007 09:31:12 :

ajout à la ligne 47 de "Set fic = folder.Files" , car les fichiers à la racine n'étaient pas supprimés. merci a Sidclimber pour son aide

04 avril 2007 09:32:30 :

mauvaise manipulation