Supprimer fichiers et repertoires datant de plus de 7 jours

Question

Bonjour,

A l'aide du script de mohax007 trouvable sur : 

http://www.vbfrance.com/codes/SUPPRIME-FICHIERS-DATANT-PLUS-15-JOURS_33195.aspx

Son script marche parfaitement pour les fichiers mais je souhaite également que les répertoires soient supprimés.

Comme je n'y connais pas grand chose en VB, je patauge énormément ! 

Voila son script un peu modifié à ma sauce, qui ne fonctionne pas (aucune erreur au lancement du script mais les répertoires ne se suppriment pas)

'*******************************************************************************
' Script permettant D 'effacer les fichiers Qui date de plus de 7 jours
' Avec interface Graphique
'
'*******************************************************************************
strComputer = "."
Set objWMIService = GetObject("winmgmts:\" & strComputer & "\root\cimv2")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("Shell.Application")		
Set objFolder = objShell.BrowseForFolder _
    (WINDOW_HANDLE, "Selectionner le dossier à traiter :", NO_OPTIONS, ".")
Set objFolderItem = objFolder.Self
strFolderName = objFolderItem.Path
Set colSubfolders = objWMIService.ExecQuery _
    ("Associators of {Win32_Directory.Name='" & strFolderName & "'} " _
        & "Where AssocClass = Win32_Subdirectory " _
            & "ResultRole = PartComponent")
'Wscript.Echo strFolderName
arrFolderPath = Split(strFolderName, "")
strNewPath = ""
For i = 1 to Ubound(arrFolderPath)
    strNewPath = strNewPath & "\" & arrFolderPath(i)
Next
strPath = strNewPath & "\"
Set colFiles = objWMIService.ExecQuery _
    ("Select * from CIM_DataFile where Path = '" & strPath & "'")

For Each objFile in colFiles
    Set objReadOnlyFile = objFSO.GetFile(objFile.Name)
     'Wscript.Echo objFile.Name & chr (10) &  objReadOnlyFile.DateLastModified
 if DateDiff("d",objReadOnlyFile.DateLastModified ,Date)>7 then
     objFile.delete
 end if
Next
Set colFolders = objWMIService.ExecQuery _
    ("Select * from CIM_DataFile where Path = '" & strPath & "'")
For Each objFolder in colFolders
   Set objReadOnlyFolder = objFSO.GetFolder(objFolder.name)
     'Wscript.Echo objFolder.Name & chr (10) & objReadOnlyFolder.DateLastModified
 if DateDiff("d",objReadOnlyFolder.DateLastModified, Date)>7 then
    objFolder.delete
 end if
Next


For Each objFolder in colSubfolders
    GetSubFolders strFolderName
Next
Sub GetSubFolders(strFolderName)
    Set colSubfolders2 = objWMIService.ExecQuery _
        ("Associators of {Win32_Directory.Name='" & strFolderName & "'} " _
            & "Where AssocClass = Win32_Subdirectory " _
                & "ResultRole = PartComponent")
    For Each objFolder2 in colSubfolders2
        strFolderName = objFolder2.Name
        'Wscript.Echo
        'Wscript.Echo objFolder2.Name
        arrFolderPath = Split(strFolderName, "")
        strNewPath = ""
        For i = 1 to Ubound(arrFolderPath)
            strNewPath = strNewPath & "\" & arrFolderPath(i)
        Next
        strPath = strNewPath & "\"
        Set colFiles = objWMIService.ExecQuery _
            ("Select * from CIM_DataFile where Path = '" & strPath & "'")
        For Each objFile in colFiles
        Set objReadOnlyFile = objFSO.GetFile(objFile.Name)
        if DateDiff("d",objReadOnlyFile.DateLastModified ,Date)>7 then
            'Wscript.Echo objFile.Name & chr (10) &  objReadOnlyFile.DateLastModified
            objFile.delete
          end if
        Next
For Each objFolder in colFolders
   	Set objReadOnlyFolder = objFSO.GetFolder(objFolder.name)
        if DateDiff("d",objReadOnlyFolder.DateLastModified, Date)>7 then
     	    'Wscript.Echo objFolder.Name & chr (10) & objReadOnlyFolder.DateLastModified
   	 objFolder.delete
 	  end if
Next
        GetSubFolders strFolderName
    Next
End Sub


Si un expert en VB connaitrait la solution... Il ferait un heureux avant de partir en vacances 
Merci

cs_Jack · Answer

Ta modif semble plausible (je n'ai jamais fait de vbs)

Dans ta syntaxe :
  'Wscript.Echo objFolder.Name & chr (10) & objReadOnlyFolder.DateLastModified
  objFolder.deleteQue donne la 1ère ligne quand tu enlèves le comment ' ?

Pour être plus juste, essaye de voir si la ligne suivante donne le même résultat :
  Wscript.Echo objFolder.Name & chr (10) & objFolder.DateLastModified(objFolder à la place de objReadOnlyFolder)

As-tu les droits suffisants pour faire une suppression de répertoire ?

Au fait, c'est compliqué pour rien :
For Each objFolder in colFolders
   Set objReadOnlyFolder = objFSO.GetFolder(objFolder.name)
   'Wscript.Echo objFolder.Name & chr (10) & objReadOnlyFolder.DateLastModified
   If DateDiff("d",objReadOnlyFolder.DateLastModified, Date)>7 then
     objFolder.delete
   End if
NextA quoi sert la variable objReadOnlyFolder ?
Je pense que cette syntaxe suffit amplement :
For Each objFolder in colFolders
   'Wscript.Echo objFolder.Name & chr (10) & objFolder.DateLastModified
   If DateDiff("d", objFolder.DateLastModified, Date) > 7 then
     objFolder.delete
   End if
NextAvec la même question à la clé : Que donne la ligne entre comment ?

Vala
Jack, MVP VB
NB : Je ne répondrai pas aux messages privés

Le savoir est la seule matière qui s'accroit quand on la partage (Socrate)

cs_Rode69 · Answer

Bonjour, 

Merci de m'aider 

J'ai fais les modifs que tu m'as conseillé et j'ai une erreur "cet objet n'est pas une collection" à la ligne 35 (For Each objFolder...)

For Each objFolder in colFolders
    Set objFolder = objFSO.GetFolder(objFolder.name)
     'Wscript.Echo objFolder.Name & chr (10) & objFolder.DateLastModified
 if DateDiff("d",objFolder.DateLastModified, Date)>7 then
    objFolder.delete

J'ai essayé d'enlever la ligne 36, d'enlever le comment ligne 37, en vain...

J'ai également changer tous les objReadOnlyFolder par objFolder dans le script.

Si toi ou quelqu'un a une autre idée, je suis partant.

cs_Rode69 · Answer

(On ne peut pas éditer son message?)
Pour régler cette erreur, il faut rajouter : 

Set colFolders = objWMIService.ExecQuery _
    ("Select * from CIM_DataFile where Path = '" & strPath & "'")

Je n'obtiens plus d'erreur mais les répertoires ne se suppriment pas. Certainement une erreur de chemin dans le script... Que je ne trouve évidemment pas.

Question droit, je suis admin local donc pas de soucis de ce niveau là.

cs_Jack · Answer

Même question : Que donne la ligne entre comment ?
Ca permettra déjà de savoir si le objFolder est bien vu (nom et date corrects)

Lorsque le programme passe sur objFolder.Delete, génère t-il une erreur ?
Ca permettra de savoir si la méthode est correcte

cs_Jack · Answer

Mais tu dis que le répertoire ne se Delete pas.
Est-ce que, au moins, ta boucle fonctionne ?
Parcoures-tu la liste des répertoires ?
Parce que se focaliser sur Delete alors c'est le reste qui ne marche pas est une mauvaise idée/méthode de dépannage

cs_Rode69 · Answer

Même question : Que donne la ligne entre comment ?
Ca permettra déjà de savoir si le objFolder est bien vu (nom et date corrects) 

Que veux-tu savoir? Je ne comprends pas bien.

Comment savoir si ma boucle fonctionne? Que le programme parcoure la liste de répertoires...

Comme je l'ai dis, vu que je n'ai aucune erreur, mon idée est que le problème vient du chemin... Faut-il préciser quelque chose pour les folders ? (vu que pour les file ca marche très bien...)

Je vais continuer à fouiner ligne par ligne ce qui me semblerai illogique... En attendant de nouvelles réponses :)

Il n'y aurait pas un pro vbs qui voudrait regarder voir s'il n'y a pas d'incohérence sur les syntaxes ou autres...?

Merci

cs_Rode69 · Answer

Bon, je suis reparti de zéro ! J'ai simplifié le script et il fonctionne maintenant.

Voici le code : 

strComputer = "."
Set objFSO = CreateObject("Scripting.FileSystemObject" )
Set objFolder = objFSO.GetFolder("C:\Test")
Set fichiers = objfolder.files
Set sousdossiers = objFolder.SubFolders

For Each objFolder in sousdossiers
 if DateDiff("d",objFolder.DateLastModified ,Date)>7 then
   objFolder.Delete
 End if
Next

For Each objFile in fichiers
 if DateDiff("d",objFile.DateLastModified ,Date)>7 then
  objFile.delete
 End if
Next



Merci de m'avoir aidé Jack ;)

Supprimer fichiers et repertoires datant de plus de 7 jours

7 réponses

Votre réponse

Discussions similaires