Probleme de Zip des fichiers

Version imprimable

BOnjour a tous.

Je cherche a zipper fichier par fichier en gardant un historique de 3 jours.

Voici mon code:

Code:

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
Set FSO = CreateObject("Scripting.FileSystemObject")
   Set objFSO = CreateObject("Scripting.FileSystemObject")
   set folder = FSO.GetFolder ("D:\test")
   Set Dossiers = fso.GetFolder(folder)
   Set fic = Dossiers.Files
   Const ForReading = 1, ForWriting = 2, ForAppending = 8
   Dim folder, MyHex, MyBinary, i
   Dim oShell, oApp, oFolder, oCTF, oFile
   Dim oFileSys
 
  'Boucle qui fait la comparaison avec la date du fichier créé et le nombres de jour des fichiers à zipper
 
   For Each objFile in fic
        Set f = fso.GetFile(objfile)
            If DateDiff("D", objfile.DateLastModified, now) > 4 Then
 
		MyHex = _
		Array(80, 75, 5, 6, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)
 
		For i = 0 To UBound(MyHex)
			MyBinary = MyBinary & Chr(MyHex(i))
		Next
 
		Set oShell = CreateObject("WScript.Shell")
		Set oFileSys = CreateObject("Scripting.FileSystemObject")
 
		'Creation du zip
			Set oCTF = oFileSys.CreateTextFile(folder, True)
			oCTF.Write MyBinary
			oCTF.Close
			Set oCTF = Nothing
 
		Set oApp = CreateObject("Shell.Application")
 
		Set oFolder = oApp.NameSpace(folder)
			If Not oFolder Is Nothing Then _
				oApp.NameSpace(folder).CopyHere oFolder.Items
 
				wScript.Sleep 5000
 
				Set oFile = Nothing
				On Error Resume Next
 
					Do While (oFile Is Nothing)
						'Attention: provoque une erreur 70 si un des fichiers à zipper
						'est toujours ouvert.
						Set oFile = oFileSys.OpenTextFile(folder, ForAppending, False)
 
							If Err.Number <> 0 Then
								Err.Clear
								wScript.Sleep 3000
							End If
					Loop
 
				Set oFile = Nothing
				Set oFileSys = Nothing
 
            		end if
    next

J'ai une erreur qui me dis acces refusé d'ou ca peux venir ?? Ou est ce que jai fait une erreur.

Merci de me le dire ou de me mettre sur la voie

12/12/2006, 09h40
SfJ5Rpw8

sur qu'elle ligne l'erreur ..?
dés la premiére utilisation ..?
12/12/2006, 11h26
lephyrexian

A la ligne 28 caracteres 4 soitpour lui ici ==>

Code:

Set oCTF = oFileSys.CreateTextFile(folder, True)

merci

Rebonjour,

Après avoir farfouiller un peu partout dans le forum j'ai trouvé un code qui fait ce que je veux mais le soucis c'est qu il est en vb6 et je voudrais le transformer en vbscript.
Pouvez vous maider svp

Code:

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
Sub ZipFichier()
    Dim oShell As Object, Fso As Object
    Dim i As Long
    Dim Fichier As String, MyBinary As String
    Dim LeZip As Variant
    Dim MyHex As Variant
 
    Fichier = "C:\le classeur.xls"
    LeZip = "C:\Ma sauvegarde.zip"
 
    Set Fso = CreateObject("Scripting.FileSystemObject")
    MyHex = _
        Array(80, 75, 5, 6, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)
 
    For i = 0 To UBound(MyHex)
        MyBinary = MyBinary & Chr(MyHex(i))
    Next
 
    With Fso.CreateTextFile(LeZip, True)
        .Write MyBinary
        .Close
    End With
 
    Set oShell = CreateObject("Shell.Application")
    oShell.NameSpace(LeZip).CopyHere (Fichier)
 
    Set oShell = Nothing
End Sub

12/12/2006, 11h44
omen999
vu rapidement, au moins deux choses anormales:
Code:

1 2 3 set folder = FSO.GetFolder ("D:\test") ... Dim folder, MyHex, MyBinary, i
redéfinir une variable après l'avoir instanciée n'est pas vraiment une bonne idée...

d'autre part, tu n'a pas bien vu la syntaxe de la méthode .CreateTextFile
folder doit être une simple variable chaine et non un objet folder

la doc de windows script est très bien faite, mais il ne faut pas oublier de la lire :aie:
12/12/2006, 11h47
lephyrexian

Excsue moi je vais peut etre posé une question bete mais ou se toruve la doc window script ^^

merci
12/12/2006, 12h01
lephyrexian

et pour ce qui est du 2 eme code a modifié pour en faire du vbs qui peux m'aider :)

merci
12/12/2006, 12h03
omen999

lire ce post: http://www.developpez.net/forums/sho...d.php?t=230947

j'ai relu ton exemple, il est non seulement inexploitable mais il ne contient aucun code capable de zipper quoi que ce soit...
12/12/2006, 14h05
lephyrexian

merci pour cette info mais sur le lien du forum le gars dis que ca marche tres bien c'est pour ca.

PS: Sur le 1 er code je vois pas mon erreur.
12/12/2006, 15h39
omen999

Code:

sur le lien du forum le gars dis que ca marche tres bien

le post original ici: http://www.codecomments.com/message295877.html

si tu lis l'anglais, tu verras qu'il s'agit d'une tentative loupée de hack pour exploiter la fonction zip de l'explorer xp
mais qui ne pouvait qu'échouer comme l'a relevé un participant :mouarf: :

Citation:

would require MS to rewrite the implementation of
CopyHere-method for ShellFolders in order to also handle
zip-files as Targets.

Citation:

Sur le 1 er code je vois pas mon erreur.

lis la doc...

Me revoila ^^ j'ai avancé sur mon pb j'arrive a zipper un fichier

Voici le code il marche.

Code:

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
Const ForReading = 1, ForWriting = 2, ForAppending = 8
 
Dim Source, Destination, MyHex, MyBinary, i
Dim oShell, oApp, oFolder, oCTF, oFile
Dim oFileSys
 
Source = "D:\test\"
Destination = "D:\save.zip"
 
MyHex = _
Array(80, 75, 5, 6, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)
 
For i = 0 To UBound(MyHex)
MyBinary = MyBinary & Chr(MyHex(i))
Next
 
Set oShell = CreateObject("WScript.Shell")
Set oFileSys = CreateObject("Scripting.FileSystemObject")
 
'Creation du zip 
Set oCTF = oFileSys.CreateTextFile(Destination, True)
oCTF.Write MyBinary
oCTF.Close
Set oCTF = Nothing
 
Set oApp = CreateObject("Shell.Application")
 
Set oFolder = oApp.NameSpace(Source)
If Not oFolder Is Nothing Then _
oApp.NameSpace(Destination).CopyHere oFolder.Items
 
wScript.Sleep 5000
 
Set oFile = Nothing
On Error Resume Next
 
Do While (oFile Is Nothing)
'Attention: provoque une erreur 70 si un des fichiers à zipper
'est toujours ouvert.
Set oFile = oFileSys.OpenTextFile(Destination, ForAppending, False)
 
If Err.Number <> 0 Then
Err.Clear
wScript.Sleep 3000
End If
Loop
 
Set oFile = Nothing
Set oFileSys = Nothing

Mon petit pb est le suivant je voudrais zipper fichier par fichier et non tout les fichiers en 1

Merci de me donner un coup de main en completant mon code svp

Merci encore.

12/12/2006, 16h07
omen999
tu es le roi du copier/coller :mouarf:
Code:

1 2 3 Set oFolder = oApp.NameSpace(Source) If Not oFolder Is Nothing Then _ oApp.NameSpace(Destination).CopyHere oFolder.Items
ce code copie en une seule fois tous les fichiers du répertoire source
pour zipper des fichiers individuels, il faut remplacer la collection oFolder.Items par le fichier de ton choix

Petite modif du script

Code:

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
Const ForReading = 1, ForWriting = 2, ForAppending = 8
 
Dim Source, Destination, MyHex, MyBinary, i
Dim oShell, oApp, oFolder, oCTF, oFile
Dim oFileSys
 
Source = "D:\test\"
Destination = "D:\save.zip"
   Set FSO = CreateObject("Scripting.FileSystemObject")
   Set objFSO = CreateObject("Scripting.FileSystemObject")
   set folder = FSO.GetFolder ("D:\test\")
   Set Dossiers = fso.GetFolder(folder)
   Set fic = Dossiers.Files
 
For Each objFile in fic
        Set f = fso.GetFile(objfile)
            If DateDiff("D", objfile.DateLastModified, now) > 4 Then
 
MyHex = _
Array(80, 75, 5, 6, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)
 
For i = 0 To UBound(MyHex)
MyBinary = MyBinary & Chr(MyHex(i))
Next
 
Set oShell = CreateObject("WScript.Shell")
Set oFileSys = CreateObject("Scripting.FileSystemObject")
 
'Creation du zip 
Set oCTF = oFileSys.CreateTextFile(Destination, True)
oCTF.Write MyBinary
oCTF.Close
Set oCTF = Nothing
 
Set oApp = CreateObject("Shell.Application")
 
Set oFolder = oApp.NameSpace(Source)
If Not oFolder Is Nothing Then _
oApp.NameSpace(Destination).CopyHere oFolder.Items
 
wScript.Sleep 5000
 
Set oFile = Nothing
On Error Resume Next
 
Do While (oFile Is Nothing)
'Attention: provoque une erreur 70 si un des fichiers à zipper
'est toujours ouvert.
Set oFile = oFileSys.OpenTextFile(Destination, ForAppending, False)
 
If Err.Number <> 0 Then
Err.Clear
wScript.Sleep 3000
End If
Loop
 
Set oFile = Nothing
Set oFileSys = Nothing
 
Set FSys = CreateObject("Scripting.FileSystemObject") 
Set MonFic = FSys.GetFile("D:\save.zip") 
MonFic.Copy "D:\test\", True 
 
 
Set FSys = CreateObject("Scripting.FileSystemObject") 
Set MonFic = FSys.GetFile("D:\save.zip") 
MonFic.delete 
 
         end if
    next

PS Omen je vois pas se que tu veux dire par mettre mon fichier désiré car le fichier est un fichier de log qui n a pas tojurs le meme nom.

Pouvez vous me dire d ou viens mon pb car la je compresse bien et je colle le fichier ou je veux. Mais le soucis est qu il me fait un zip du zip en boucle. Et il continue a me prendre tous les fichiers.

Merci de votre aide

13/12/2006, 12h08
omen999
Citation:

Mais le soucis est qu il me fait un zip du zip en boucle

remplace :roll: :
Code:

1 2 3 oApp.NameSpace(Destination).CopyHere oFolder.Items par oApp.NameSpace(Destination).MoveHere oFolder.Items
de toute façon, c'est un hack pourri qui remplace le nom d'un répertoire par un nom de fichier zip vide dans la méthode .NameSpace
mais comme la compression est asynchrone, le script doit ensuite prévoir une temporisation variable selon les perfs de la machine avant de pouvoir utiliser le zip
casse-gueule garanti :wow:
13/12/2006, 13h47
lephyrexian

Merci pour ton, aide mais apres avoir remplacer ce que tu mas dis ca fait toujours pareil il boucle en faisant le zip

T as d autre conseil ou sinon dis moi comment faire pour qu je puisse zipper en gardant un historique de 3 jours.

Merci de m aider encore :)
13/12/2006, 15h44
omen999

Citation:

T as d autre conseil

un composant com freeware basique mais qui autorise la compression
d'un répertoire entier: http://xstandard.com/page.asp?p=C8AA...A-B6679AA949E6

ou molezip: http://devtools.teggo.com/molezip/
15/12/2006, 10h17
lephyrexian

Bonjour,

Merci encore pour ton aide mais en faite je voudrais garder mon script. y aurait il quelqun qui saurias me le modifier pour qu il marche merci .