Discussion :

[superseb9]

Bonjour,

J'ai actuellement un script VBS pour supprimer les fichiers vieux de 1 mois mais j'aimerais que ceux-ci soit déplacé dans un répertoire "Corbeille", que dois-je modifier dans mon script VBS?

Merci beaucoup :

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
'Repertoire ou sont stockes les fichiers 
DossierEchangesTemporaire = "\\192.168.1.75\Test Script" 
 
'Nombre de jours de conservation des Fichiers 
AgeMaximalFichiers = "30" 
 
'Comptage des fichiers effaces 
NbFichiersEffaces = 0 
'Nom du Fichier  Log  suivant  La Date  systeme
LogFile_Date = "LogFile_" & 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 Echanges Temporaire existe 
If (myName = Winrep = fso.FolderExists(DossierEchangesTemporaire)) = False Then 
    Erreur = MsgBox("Le dossier Echanges Temporaire est introuvable !" ) 
    Wscript.Quit 
End If 
 
'On recupere la date systeme 
DateSysteme = Date 
 
'On apelle la fonction d'effacement 
 
Clean(DossierEchangesTemporaire) 
 
 
'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 
      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
OutPut.WriteLine Cstr(NbFichiersEffaces) + " Fichiers ont été Supprimés !"
OutPut.WriteLine "*************************************************************************************************"
'MsgBox Cstr(NbFichiersEffaces) + " Fichiers ont été Supprimés !",64," Les Fichiers Supprimés"

Sébastien

[Cachlab]

Salut Superseb9 !

A priori, il suffit de définir un dossier de destination (ligne 3) et de remplacer la commande d'effacement par une commande de déplacement de fichier (ligne 58) :

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
'Repertoire ou sont stockes les fichiers 
DossierEchangesTemporaire = "\\192.168.1.75\Test Script" 
DossierArchives = "\\192.168.1.75\Archives\"
 
'Nombre de jours de conservation des Fichiers 
AgeMaximalFichiers = "30" 
 
'Comptage des fichiers effaces 
NbFichiersEffaces = 0 
'Nom du Fichier  Log  suivant  La Date  systeme
LogFile_Date = "LogFile_" & 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 Echanges Temporaire existe 
If (myName = Winrep = fso.FolderExists(DossierEchangesTemporaire)) = False Then 
    Erreur = MsgBox("Le dossier Echanges Temporaire est introuvable !" ) 
    Wscript.Quit 
End If 
 
'On recupere la date systeme 
DateSysteme = Date 
 
'On apelle la fonction d'effacement 
 
Clean(DossierEchangesTemporaire) 
 
 
'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 
      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é
            fSO.MoveFile File, DossierArchives & File.Name
            NbFichiersEffaces = NbFichiersEffaces + 1 
        End If 
Next 
End Sub
OutPut.WriteLine Cstr(NbFichiersEffaces) + " Fichiers ont été Supprimés !"
OutPut.WriteLine "*************************************************************************************************"
'MsgBox Cstr(NbFichiersEffaces) + " Fichiers ont été Supprimés !",64," Les Fichiers Supprimés"

Pour le reste, je te laisse le soin de corriger le fichier log en remplaçant les infos "Fichiers Supprimés !" par "Fichiers déplacés !" ...
Bonne journée ! ++

[superseb9]

Merci beaucoup.

Questions subsidiaire :

Le script concerne la "date de création" ou "modifié le "

Merci

P.S.: moi, je suis intéressé par la date de création.

[Cachlab]

Salut !

Il s'agit en effet de la date de dernière modification actuellement ...
Pour comparer la date de création du fichier, il faut modifier la ligne 53 :

Code :

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

If (DateDiff("d", File.DateCreated, DateSysteme) > CInt(AgeMaximalFichiers)) Then

Plus d'info ?
++

[l_autodidacte]

Au passage, au lieu d'utiliser "CInt" pour transtyper une variable en entier telle que AgeMaximalFichiers = "30", il est légal de la déclarer comme constante Integer :
Const AgeMaximalFichiers = 30 et la ligne de code proposé par Cachlab devient :
If (DateDiff("d", File.DateCreated, DateSysteme) > AgeMaximalFichiers) Then.
sans avoir besoin de conversion.