VBS : Purge de dossiers et sous-dossiers

Question

Bonjour, 

Les ami(e)s voila j'ai un petit problème sur mon script VBS. Il me supprime bien les ficheirs a la racine de mon dossier mais pas dans les dossiers a l'interieur de celui-ci et encore moins les dossiers je galère depuis 14h sur le probleme et j'aura besoi nd'un petit regarde exterieur et coup de main.

Merci d'avance

Voici le script :


'Les declarations 
 
 
'Repertoire ou sont stockes les fichiers 
DossierSauvegarde = "C:\Users	.besseau\Desktop\1\" 
 
'Nombre de jours de conservation des Fichiers 
AgeMaximalFichiers = "2" 
 
'Comptage des fichiers effaces 
NbFichiersEffaces = 0 
 
'Initialisation des objets 
Set fso = CreateObject("Scripting.FileSystemObject" ) 
 
'On verifie que le repertoire de sauvegarde existe 
If (myName = Winrep = fso.FolderExists(DossierSauvegarde)) = False Then 
    Erreur = MsgBox("Le dossier de sauvegarde est introuvable !" ) 
    Wscript.Quit 
End If 
 
'On recupere la date système 
DateSysteme = Date 
 
'Suppression des fichiers trop anciens 
 
Set Folder = fso.Getfolder(DossierSauvegarde) 
For Each File In Folder.Files 
        If (DateDiff("d", File.DateLastModified, DateSysteme) > CInt(AgeMaximalFichiers)) Then 
            'On verifie qu'ils ne sont pas en lecture seule 
            If File.Attributes And 1 Then File.Attributes = File.Attributes - 1 
            File.Delete() 
            NbFichiersEffaces = NbFichiersEffaces + 1 
        End If 
Next


 



Configuration: Windows 7 / Internet Explorer 9.0

Lord Zero · Accepted Answer

Le mien est mieu si tu veux et fonctionnel

Removal_files.vbs
supprime les fichier qui date de plus de X jours, les valeurs en gras sont a modifier.

     strComputer = "."

   Set objWMIService = GetObject("winmgmts:\" & strComputer & "oot\cimv2" )
   Set objFSO = CreateObject("Scripting.FileSystemObject" )
   Set objShell = CreateObject("Shell.Application" )   
  strFolderName = ("Chemin du dossier")

   Set colSubfolders = objWMIService.ExecQuery _
       ("Associators of {Win32_Directory.Name='" & strFolderName & "'} " _
           & "Where AssocClass = Win32_Subdirectory " _
               & "ResultRole = PartComponent" )

   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)>15 then

       objFile.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
           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)>15 then
               'Wscript.Echo objFile.Name & chr (10) & objReadOnlyFile.DateLastModified
               objFile.delete

             end if

           Next

           GetSubFolders strFolderName
       Next
   End Sub


et removal_folder.vbs

Supprime dossier, sous dossier vide.

Option Explicit

Const pfad = ("Chemin du dossier")

Dim Text, Title, index, Txt()
Dim fso, wsh, i

index = 1

Set wsh = WScript.CreateObject ("WScript.Shell")

Set fso = WScript.CreateObject("Scripting.FileSystemObject") 

RecFolder index, wsh.ExpandEnvironmentStrings(pfad) 

Function RecFolder (idx, pfad) 

Dim fo, fc, i, colFiles, file 

Set fo = fso.GetFolder(pfad) 
Set fc = fo.SubFolders
Set colFiles = fo.Files

For Each i in fc 
Call RecFolder (idx+1, pfad + "\" + i.name) 

If i.Files.Count = 0 And i.SubFolders.Count = 0 Then 
fso.DeleteFolder(pfad + "\" + i.name)
End if
Next
End function

VBS : Purge de dossiers et sous-dossiers

1 réponse

Discussions similaires

Newsletters