compression de répertoire

Version imprimable

Bonjour, j'ai un script pour compresser un répertoire:

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
'Source
'http://www.codecomments.com/archive299-2006-2-295877.html
'
Const ForReading = 1, ForWriting = 2, ForAppending = 8
 
Dim Source, Destination, MyHex, MyBinary, i
Dim oShell, oApp, oFolder, oCTF, oFile
Dim oFileSys
 
Set WshShell = WScript.CreateObject("WScript.Shell") 
DesktopPath = WSHShell.SpecialFolders("Desktop")
 
Source = "C:\Documents and Settings\Kookatix\Bureau\Nouveau dossier"
Destination = DesktopPath & "\maSauvegarde.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

Le probléme c'est qu'il me renvoi une erreur si un sou répertoire est vide, sauriez vous comment annuler ce message d'erreur ?

06/02/2008, 17h06
omen999

salut,

problème déjà évoqué ici:

http://www.developpez.net/forums/sho...d.php?t=248955
http://www.developpez.net/forums/sho...d.php?t=263852

bonne lecture :aie:
06/02/2008, 17h09
koKoTis

merci pour ces liens mais ce n'est pas la même erreur

Salut,

voici ce que je propose :

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
'Source
'http://www.codecomments.com/archive299-2006-2-295877.html
'
Const ForReading = 1, ForWriting = 2, ForAppending = 8
 
Dim Source, Destination, MyHex, MyBinary, i
Dim oShell, oApp, oFolder, oCTF, oFile
Dim oFileSys
 
Set WshShell = WScript.CreateObject("WScript.Shell") 
DesktopPath = WSHShell.SpecialFolders("Desktop")
 
Source = "C:\Temp"
Destination = DesktopPath & "\maSauvegarde.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)
 
Set FSO = CreateObject("Scripting.FileSystemObject")
 
oApp.NameSpace(Destination).CopyHere Source
 
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

Dis moi si ca marche ou pas.

A++

06/02/2008, 17h52
koKoTis

ca fonctionne parfaitement, merci beaucoup ;)