Suprimer les dossiers vieux de 15 joursRésolu

Question

Re bonjour 
J'essaye de créer un script qui supprime dans un répertoir, les sous-dossier vieux de 15 jours 

J'ai essayé de faire ce que j'ai pu avec mes recherches et voilà ce que sa donne 

 Option Explicit 
 on error resume Next

 'declaration des variables
 Dim A, fic, folder, Subfolder, path, FSO, B
 

 Set FSO = CreateObject("Scripting.FileSystemObject")
 set folder = FSO.GetFolder ("C:\Archive\ArchiveLog") 
 set Subfolder = folder.SubFolders 
 Set fic = folder.Files 

    'Supprime les fichiers situé" dans le sous repertoir 
 For each A in Subfolder 
     Set fic = A.Files 
     For Each objFile In fic 
        Set f = fso.GetFile(objfile) 
         If DateDiff("D", objfile.DateLastModified, now) > 15 Then 
                 FSO.DeleteFile f, force = yes
         end If 
     Next
 Next

    'Supprime le dossier si il est vide 
 For Each B in folder.subfolders
     If B.size = 0 Then 
         FSO.DeleteFolder B, force = yes
     End If 
 Next

Wscript.qui (0)

Pouvez vous me corriger car evidement ça tourne pas rond !!!

Olety (merci en langue KanakY)

jrivet · Accepted Answer

Salut,
Je ne sais pas si j'ai tout bien compris mais regarde ce petit code.
NOTE:Que doit t'on faire si un sous répertoire contient lui même des sous répertoires? ==> Ce cas n'est pas traité avec cet exemple.
Dim Fso, Fol, Fi
   
   Set Fso = CreateObject("Scripting.FileSystemObject")
   'POur chaque sous répertoire du répertoire à verifier
   For Each Fol In Fso.GetFolder("C:\Julien").SubFolders
       'Pour chaque fichiers de ce sous répertoire
       For Each Fi In Fol.Files
           'Si il faut on le supprime
           If DateDiff("d", Fi.DateLastModified, Date) > 15 Then Call Fi.Delete(True)
       Next
       'Si le sous répertoire ne contient plus de Fichiers on l'efface
       If Fol.Size = 0 Then Call Fol.Delete(True)
   Next , ----
[code.aspx?ID=41455 By Renfield]

@+: Ju£i?n
Pensez: Réponse acceptée

FMatrix07 · Answer

Bonjour

Je ne connais pas trop le vbs mais as tu regardé cette source

http://www.vbfrance.com/codes/SUPPRIME-FICHIERS-DATANT-PLUS-15-JOURS_33195.aspx

En changant les parametres tu peux tres bien le faire sur les répertoires au lieux des fichiers

@+: SCCréat
Pensez:  Réponse acceptée

Mail:Stéphan.COCHET

McDEV04 · Answer

Il à l'air interressant mais ça ne correspond pas à ce que je veux.
Merci quand même

En faite c'est surtout le repertoire et son contenu qu je veux supprimer, et je n'ai pas besoin d'une interface graphique car mon script doit pouvoir s'executer en tache de fond et sans l'intervention d'un tier. 

Bon c'est le WE ché  moi et comme j'ai le net que au boulot, je ne pourrais vous répondre tout de suite, mais je vous assure que je vous répondrer dés mon retour. 

Tchao et bon Week end à vous !!!

cs_JMO · Answer

Bonsoir à tous,

Salut McDEV04,

1er script:
Option Explicit     
Const objPath =  "C:\Archive\ArchiveLog"            
Dim objFso, strFolderDeleted, strNotFolderDeleted
Set objFso = CreateObject("Scripting.FileSystemObject")

MsgBox DeletedFolder(objFso.GetFolder(objPath)),,"Deleted Folders"
MsgBox strNotFolderDeleted,,"Not Deleted Folders"
Set objFso = Nothing

Function DeletedFolder(objFolder)
Dim objSubFolder, objSubFolders
For Each objSubFolders In objFolder.SubFolders
    If DateDiff("d", Now, objSubFolders.DateCreated) <= -15 Then
       strFolderDeleted = strFolderDeleted & "Folder Delete: " & _
                          objSubFolders.DateCreated &vbTab&  _ 
                          objSubFolders.Path &vbcr
'''''''objFso.DeleteFolder objSubFolders.Path, True
    Else
       strNotFolderDeleted = strNotFolderDeleted & _ 
                             "Not Deleted Folder: " & _ 
                             objSubFolders.DateCreated &vbTab& _
                             objSubFolders.Path &vbcr
    End If
Next
For Each objSubFolder In objFso.GetFolder(objFolder).SubFolders
    DeletedFolder objSubFolder
Next
DeletedFolder = strFolderDeleted
End Function

 2ème script: 
Option Explicit     

Const objPath  = "C:\Archive\ArchiveLog"            

Dim objFso

Set objFso = CreateObject("Scripting.FileSystemObject")


MsgBox DeletedFolder(objFso.GetFolder(objPath)),,"Deleted Folders"
' ou Call DeletedFolder(objFso.GetFolder(objPath))
Set objFso = Nothing


Function DeletedFolder(objFolder)

Dim objSubFolder, objSubFolders

For Each objSubFolders In objFolder.SubFolders

    If DateDiff("d", Now, objSubFolders.DateCreated) <= -15 Then
'''''''objFso.DeleteFolder objSubFolders.Path, True
    End If

Next

For Each objSubFolder In objFso.GetFolder(objFolder).SubFolders

    DeletedFolder objSubFolder

Next

DeletedFolder = strFolderDeleted

End Function

jean-marc

McDEV04 · Answer

Bonjour à vous Messieurs
je me met au boulot et je vous donne des nouvelles

Merci beaucoup!!!

McDEV04 · Answer

Il n'y a pas de  sous repertoire dans le sous repertoire à supprimer mais que des fichier .log et .txt (pour information)

McDEV04 · Answer

Je viens de tester le script de julien MAGNIFIQUE, 
je vais tester les deux autres scripts de Jean Marc maintenant.
à tout à l'heure!!!!

McDEV04 · Answer

Pas trés commode la nouvelle présentation du site. On ne peut pas voir tous les post en  entier (pas assez large) Obliger de faire un copier coller sur un bloc note pour tous lire. Enfin si vous voyez ce que je veut dire??

McDEV04 · Answer

Voilà j'ai effectué les tests sur les deux script de JM. Rien à dire il tourne formidablement bien tous les deux. j'ai juste eu un peu de mal à comprendre ceux de JM (à cause de mon niveau), mais avec un peu de recule j'y suis arrivé en tout cas merci. Comparé a ce que j'ai codé et à ce que j'ai pu trouvé sur le net ces trois script sont les plus simples. 

 Merci a vous deux qui avaient  si gentillement pris le temps de me répondre

Suprimer les dossiers vieux de 15 jours

9 réponses

Votre réponse

Discussions similaires