Discussion :

[01Please]

comment faire un script pour compressé des fichiers dans un dossier d’archivage de sauvegarde. La condition à respecter : les fichiers dans un dossier doivent être les plus récent, on n’archive pas les vieux fichiers mais leur date de création ou de modification doit être supérieur à une date d’un fichier x donné. Par exemple : mon fichier donnée se trouve dans le C:\\sauvegarde et il a comme date le 20/05/2014 alors je dois archiver les fichiers du 14/05/2014 au 20/05/2014. Je pense il faut faire un script VBS comme je l’ai fait pour la suppression des vieux fichiers (remplacer clean par copy mais je n’y parviens pas)
Voici le script pour la suppression des fichiers :

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
 'Initialisation du nom du fichier
   sFileName = "T:\PRO\Sauvegarde\testFichierEfface\Verification\Verification_Sauvegarde.txt"
 
 ' Récupérer l'instance du fichier.
   Set fso = CreateObject("Scripting.FileSystemObject")
 
 ' On récupére la date de modification du fichier .txt ou la date de la dernière sauvegarde est inscrite
If fso.FileExists("T:\PRO\Sauvegarde\testFichierEfface\Verification\Verification_Sauvegarde.txt" ) = True Then 
 Set oFile = fso.GetFile("T:\PRO\Sauvegarde\testFichierEfface\Verification\Verification_Sauvegarde.txt" ) 
 dtmDateModifie = oFile.DateLastModified
 Set oFolder = Nothing 
Else 
 dtmDateModifie = "Unknown" 
End if 
 
‘Repertoire ou sont stockés les fichiers 
DossierSauvegarde = "T:\PRO\Sauvegarde\testFichierEfface" 
 
'Nombre de jours de conservation des Fichiers  (28 jours)
AgeMaximalFichiers = "28" 
 
'Comptage des fichiers effaces 
NbFichiersEffaces = 0 
NbDossiersEffaces = 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("T:\PRO\Sauvegarde\testFichierEfface\logs\" & LogFile_Date & ".txt") Then
Set OutPut = fso.CreateTextFile("T:\PRO\Sauvegarde\testFichierEfface\logs\" & 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("T:\ PRO\Sauvegarde\testFichierEfface\logs\" & 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 apelle la fonction d'effacement 
Clean(DossierSauvegarde) 
 
'Fonction d'effacement des fichiers 
Sub Clean(FolderPath) 
 Set Folder = fso.Getfolder(FolderPath) 
 
'On appelle récursivement 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 refusee)"
     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, dtmDateModifie) > 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 
            File.Delete() 
            NbFichiersEffaces = NbFichiersEffaces + 1 
        End If 
Next 
End Sub
 
 'On efface les dossiers et sous-dossiers vides
 Const pfad = ("T:\ PRO\Sauvegarde\testFichierEfface")
 
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 ete Supprimes !" + " et " + Cstr(NbDossiersEffaces) + " Dossiers ont ete Supprimes !" 
OutPut.WriteLine "*************************************************************************************************"
MsgBox (Cstr(NbFichiersEffaces) + " fichiers ont ete effaces" + " et " + Cstr(NbDossiersEffaces) + " Dossiers ont ete Supprimes !" )

J’ai réussi seulement à faire un copier coller d’un fichier et de le mettre en zip sauf que lorsque je veux l’ouvrir, il s’ouvre pas :

Code :

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

1
2
3
4
5
6
7
dim filesys
set filesys=CreateObject("Scripting.FileSystemObject") 
 
 
If filesys.FileExists("T:\PRO\Sauvegarde\testFichierEfface\LEVEL.txt") Then 
filesys.CopyFile "T:\PRO\Sauvegarde\testFichierEfface\LEVEL.txt", "T: \PRO\Sauvegarde\testFichierEfface\archive\LEVEL.zip" 
End If

[hackoofr]

Peut-être une piste en utilisant la commande XCopy.exe avec le commutateur /D:j-m-a

/D:j-m-a ===> Copie les fichiers modifiés à partir de la date spécifiée. Si aucune date n'est donnée, copie uniquement les fichiers dont l'heure source est plus récente que l'heure de destination. Utile pour les sauvegardes.

Vous pouvez facilement modifier ce script au niveau de la variable Param

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
Option Explicit
Dim sSrc,sDest,MyCmd,Temp,Titre,MsgTitre,MsgAttente,Copyright,oExec,ws,LogTmpFile,LogFile,MyExcludeFile,Param
Copyright = "[ XcopyScript © Hackoo Crackoo © 2014 ]"
Set ws = CreateObject("WScript.Shell")
Temp = ws.ExpandEnvironmentStrings("%Temp%")
sSrc = "C:\Downloads"
sDest = "E:\XCopytest"
LogTmpFile = "MyTmpXCopyLog.txt"
LogFile = "MyXCopyLog.txt"
Param = " /D /Y /E /F"
MyCmd = "XCopy" & " " & DblQuote(sSrc) & " " & DblQuote(sDest) & " " & Param &" > " & LogTmpFile &_
" & cmd /U /C Type " & LogTmpFile & " > " & LogFile & " & Del " & LogTmpFile & ""
Titre = "Copie de Sauvegarde " & Copyright
MsgAttente = "Copie de Sauvegarde : <font color=Yellow>" & DblQuote(sSrc) & " vers " & DblQuote(sDest) & " </font>  . . . ."
Call CreateProgressBar(Titre,MsgAttente)
Call LancerProgressBar()
Call Pause(2)
Call Executer(MyCmd,0)
Call FermerProgressBar()
ws.run LogFile
'****************************************************************************************************
 Function Executer(StrCmd,Console)
    Dim ws,MyCmd,Resultat
    Set ws = CreateObject("wscript.Shell")
'La valeur 0 pour cacher la console MS-DOS
    If Console = 0 Then
        MyCmd = "CMD /C " & StrCmd & " "
        Resultat = ws.run(MyCmd,Console,True)
        If Resultat = 0 Then
        Else
            MsgBox "Une erreur inconnue est survenue !",16,"Une erreur inconnue est survenue !"
        End If
    End If
'La valeur 1 pour montrer la console MS-DOS
    If Console = 1 Then
        MyCmd = "CMD /K " & StrCmd & " "
        Resultat = ws.run(MyCmd,Console,False)
        If Resultat = 0 Then
        Else
            MsgBox "Une erreur inconnue est survenue !",16,"Une erreur inconnue est survenue !"
        End If
    End If
    Executer = Resultat
End Function
'****************************************************************************************************
Sub CreateProgressBar(Titre,MsgAttente)
    Dim ws,fso,f,f2,ts,ts2,Ligne,i,fread,LireTout,NbLigneTotal,Temp,PathOutPutHTML,fhta,oExec
    Set ws = CreateObject("wscript.Shell")
    Set fso = CreateObject("Scripting.FileSystemObject")
    Temp = WS.ExpandEnvironmentStrings("%Temp%")
    PathOutPutHTML = Temp & "\Barre.hta"
    Set fhta = fso.OpenTextFile(PathOutPutHTML,2,True)
    fhta.WriteLine "<HTML>"
    fhta.WriteLine "<HEAD>"
    fhta.WriteLine "<Title>  " & Titre & "</Title>"
    fhta.WriteLine "<HTA:APPLICATION"
    fhta.WriteLine "ICON = ""magnify.exe"" "
    fhta.WriteLine "BORDER=""THIN"" "
    fhta.WriteLine "INNERBORDER=""NO"" "
    fhta.WriteLine "MAXIMIZEBUTTON=""NO"" "
    fhta.WriteLine "MINIMIZEBUTTON=""NO"" "
    fhta.WriteLine "SCROLL=""NO"" "
    fhta.WriteLine "SYSMENU=""NO"" "
    fhta.WriteLine "SELECTION=""NO"" "
    fhta.WriteLine "SINGLEINSTANCE=""YES"">"
    fhta.WriteLine "</HEAD>"
    fhta.WriteLine "<BODY text=""white""><CENTER><DIV><SPAN ID=""ProgressBar""></SPAN>"
    fhta.WriteLine "<span><marquee DIRECTION=""LEFT"" SCROLLAMOUNT=""3"" BEHAVIOR=ALTERNATE><font face=""Comic sans MS"">" & MsgAttente &"</font></marquee></span></DIV></CENTER></BODY></HTML>"
    fhta.WriteLine "<SCRIPT LANGUAGE=""VBScript""> "
    fhta.WriteLine "Set ws = CreateObject(""wscript.Shell"")"
    fhta.WriteLine "Temp = WS.ExpandEnvironmentStrings(""%Temp%"")"
    fhta.WriteLine "Sub window_onload()"
    fhta.WriteLine "    CenterWindow 500,90"
    fhta.WriteLine "    Self.document.bgColor = ""DarkOrange"" "
    fhta.WriteLine " End Sub"
    fhta.WriteLine " Sub CenterWindow(x,y)"
    fhta.WriteLine "    Dim iLeft,itop"
    fhta.WriteLine "    window.resizeTo x,y"
    fhta.WriteLine "    iLeft = window.screen.availWidth/2 - x/2"
    fhta.WriteLine "    itop = window.screen.availHeight/2 - y/2"
    fhta.WriteLine "    window.moveTo ileft,itop"
    fhta.WriteLine "End Sub"
    fhta.WriteLine "</script>"
    fhta.close
End Sub
'**********************************************************************************************
Sub LancerProgressBar()
    Set oExec = Ws.Exec("mshta.exe " & Temp & "\Barre.hta")
End Sub
'**********************************************************************************************
Sub FermerProgressBar()
    oExec.Terminate
End Sub
'**********************************************************************************************
Sub Pause(NSeconds)
    Wscript.Sleep(NSeconds*1000)
End Sub  
'**********************************************************************************************
Function DblQuote(Str)
    DblQuote = Chr(34) & Str & Chr(34)
End Function
'**********************************************************************************************

[01Please]

WAW merciiiii beaucoup ça fonctionne mais il reste quelques petits détails à rajouter, surement un if pour sélectionner les fichiers les plus récents, il faudrait également parcourir les sous dossiers et pour finir ça sera bien de compresser les fichiers copiés (je n'ai aucune idée de comment faire) pour gagner plus d'espace sur le disque dur

[hackoofr]

ça sera bien de compresser les fichiers copiés (je n'ai aucune idée de comment faire) pour gagner plus d'espace sur le disque dur

Vous pouvez utiliser Compression(Source,Destination,Password)

[hackoofr]

Si vous combiner les deux scripts ensemble ça va résoudre votre problème, alors il faut faire des tests
Par contre si vous trouviez un petit problème, alors poster le code combiné et modifié et
@+

[01Please]

[01Please]

je n'ai pas changé grand choses pour l'instant c'est pourquoi je n'ai pas inséré mon code modifié au post Mais j'aurais voulut savoir comment résoudre l'erreur de mon post précédente: comme définir cette variable?