Discussion :

[chtitgus]

Bonjour à tous,

Je sollicite votre aide car je bloque...

J'ai un script VBS que j'utilise en tâche planifié sur mon serveur de données. Il sert à supprimer tous les fichiers d'un répertoire qui sont plus vieux que 7 jours.

Le script fait ce que je lui demande, pas de soucis là dessus, mais il me marque une erreur:



Voici le code utilisé:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
 
 
 
 
'Repertoire ou sont stockes les fichiers 
DossierSauvegarde = "\\servdonnee\XXX\XXXX" 
 
'Nombre de jours de conservation des Fichiers 
AgeMaximalFichiers = "7" 
 
'Comptage des fichiers effaces 
NbFichiersEffaces = 0 
'Nom du Fichier  Log  suivant  La Date  systeme
LogFile_Date = "FichierLog_" & Day(Now) & "_" & Month(Now) & "_" & Year(Now)
'Initialisation des objets 
Set fso = CreateObject("Scripting.FileSystemObject" )
if not fso.fileExists(LogFile_Date & ".txt") Then
Set OutPut = fso.CreateTextFile(LogFile_Date & ".txt",8)
OutPut.WriteLine "*************************************************************************************************"
OutPut.WriteLine "Nous sommes Le " &  Day(Now) & "/" & Month(Now) & "/" & Year(Now)& " La liste des Fichiers Supprimés a cette heure " & Time & " est :"  
OutPut.WriteLine "*************************************************************************************************"
else
Set OutPut = fso.OpenTextFile(LogFile_Date & ".txt",8)
OutPut.WriteLine "*************************************************************************************************"
OutPut.WriteLine "Nous sommes Le " &  Day(Now) & "/" & Month(Now) & "/" & Year(Now)& " La liste des Fichiers Supprimés a cette heure " & Time & " est :" 
OutPut.WriteLine "*************************************************************************************************"
end if
'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 systeme 
DateSysteme = Date 
 
'On apelle la fonction d'effacement 
 
Clean(DossierSauvegarde) 
 
 
'Fonction d'effacement des fichiers 
Sub Clean(FolderPath) 
 
Set Folder = fso.Getfolder(FolderPath) 
 
'On appelle recursivement la fonction s'il y a des sous dossiers 
 
Set SubFolder = Folder.SubFolders 
   For Each CurrentFolder in SubFolder 
 
	If CurrentFolder.Size = 0 Then
     OutPut.WriteLine CurrentFolder.Path & " (Dossier vide)"
     NbDossiersEffaces = NbDossiersEffaces + 1
 
     		If Err.Number = 70 Then ' Si permission refusée
         OutPut.WriteLine CurrentFolder.Path & " (Permission de suppression refusée)"
     		End If
 	  End If
 
Clean CurrentFolder.Path 
   Next 
 
'On efface les fichiers dans le dossier courant 
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 
 
	OutPut.WriteLine File.Path 'Ecrire  le chemin du Fichier Supprimé
            File.Delete() 
            NbFichiersEffaces = NbFichiersEffaces + 1 
        End If 
Next 
End Sub
 
 'On efface les dossiers et sous-dossiers vides
 Const pfad = ("\\servdonnee\XXX\XXXX")
 
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
 
OutPut.WriteLine Cstr(NbFichiersEffaces) + " Fichiers ont été Supprimés !"
OutPut.WriteLine "*************************************************************************************************"

Pas de soucis de droits sur le dossier en question. Auriez-vous une idée ?

Merci par avance

[l_autodidacte]

Jette un coup d’œil sur ce CODE et modifie-le selon ton besoin.