Supprimer des sous dossiers

Résolu
Signaler
Messages postés
2
Date d'inscription
lundi 6 février 2006
Statut
Membre
Dernière intervention
8 février 2006
-
Messages postés
2
Date d'inscription
lundi 6 février 2006
Statut
Membre
Dernière intervention
8 février 2006
-
Bonjour,
je cherche a supprimer par un script vbs et tache planifié des sous dossiers (et tout ce qu'il y a à l'interrieur) dont la date de création est supperieure à 60 jours.

Merci de vos réponses

3 réponses

Messages postés
2
Date d'inscription
lundi 6 février 2006
Statut
Membre
Dernière intervention
8 février 2006

En fait en prenant un peu de temps j'ai pu me faire un petit truc, je le met sur le forume ça pourra toujours aider...

Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.GetFolder("votre chemin du repertoire parent")
Set fc = f.SubFolders
datenow=date
For Each f1 in fc
date1=f1.DateCreated
if DateDiff("d", date1, datenow) >60 then
f1.delete
end if
Next
3
Merci

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

Codes Sources 109 internautes nous ont dit merci ce mois-ci

Messages postés
3874
Date d'inscription
mardi 8 mars 2005
Statut
Modérateur
Dernière intervention
7 novembre 2014
15
FileSystemObject.

C'est le nom de l'objet que je crois qu'il faut que tu utilise.

http://msdn.microsoft.com/library/default.asp?url=/library/en-us/VBRef98/html/vbmscLROverview.asp

puis "Language Reference"
puis "Objects"
puis "F"
puis "FileSystemObject Object"

La liste des méthodes (actions) et propriétés est alors accessible.

Si tu n'aimes pas l'Anglais, tape rechercher FileSystemObject dans rechercher un peu plus haut.
Messages postés
1854
Date d'inscription
jeudi 23 mai 2002
Statut
Membre
Dernière intervention
24 juin 2018
26
Bonsoir,

Sur ce site, comme Google, il y a l'input "Recherche"....merci Nix.
En farfouillant, on trouve tout, ou presque.
Ci-dessous, un code WMI que j'ai trouvé sur le forum.

'*******************************************************************************
' Script permettant D 'effacer les fichiers Qui date de plus de 15 jours
' Avec interface Graphique
' Script VBS "http://www.vbfrance.com/code.aspx?id=33195 de mohax007"
'*******************************************************************************


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 "Répertoire: " & 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 & "'")
'Dim count1, count2, count3
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) <15 then
Else
'MsgBox objFile.Name
'count2 = 1 + count2
'count1 = " compteur1 " & count2 & " " & objFile.Name &vbCrLf& count1
count1 = "Répertoire: " & objFile.Name &vbCrLf& count1
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")

'Dim count3
'count3 = 1
For Each objFolder2 in colSubfolders2
strFolderName = objFolder2.Name
'Wscript.Echo "Sous-répertoire:" & 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 & "'")
'count3 = 1
For Each objFile in colFiles
Set objReadOnlyFile = objFSO.GetFile(objFile.Name)
'MsgBox count3
If DateDiff("d",objReadOnlyFile.DateLastModified ,Date) <15 then
Else
'MsgBox count1 & " " & count3
'count3 = count3 + 1
'count1 = count3 & " compteur2 " & count3 & " " & objFile.Name &vbCrLf& count1
count1 = "Sous-répertoire: " & objFile.Name &vbCrLf& count1
End If
Next

GetSubFolders strFolderName
Next
End Sub
MsgBox "Les fichiers suivants viennent d'être supprimés car non modifiés depuis 15 jours:"&vbCrLf&vbCrLf& count1 &vbCrLf
MsgBox "fin de ce script"
Set objWMIService = Nothing
Set objFSO = Nothing
Set objShell = Nothing