VBS : Purge de dossiers et sous-dossiers

Tony85 Messages postés 72 Date d'inscription Statut Membre Dernière intervention -
Lord Zero Messages postés 459 Date d'inscription Statut Membre Dernière intervention - 2 déc. 2010 à 16:49

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\t.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

A voir également:

VBS : Purge de dossiers et sous-dossiers
Vbs windows - Accueil - Optimisation
Vbs - Télécharger - Édition & Programmation
Vbs editor - Télécharger - Édition & Programmation
Fichier vbs ✓ - Forum Virus
Vbs malware gen ✓ - Forum Virus

1 réponse

Réponse 1 / 1

Lord Zero Messages postés 459 Date d'inscription Statut Membre Dernière intervention 115

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 & "\root\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

Discussions similaires

Faire une pause en VBS

VBS.Runauto

Comment lancer mon vbs

Pause dans un Script VB

Impossible de trouver le fichier script .vbs

Votre réponse

Discussions similaires