compresser un dossier

**kevain_09** · 02/09/2006, 13h17

je cherche un code vbs qui permettrai de compresser un dossier afin de pouvoir l'envoyer par mail ensuite.

j'ai deja le code pour l'envoi par mail, il me manque celui de la compression.

j'aimerais utiliser l'utilitaire de compression/decompression de windows XP (et non pas les classique winzip ou winrar)

si quelqun sait comment faire...

Merci

**SilkyRoad** · 02/09/2006, 18h23

bonjour

j'espere que ces infos pourront t'aider

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
'
'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
 
Source = "C:\Documents and Settings\michel\mon dossier"
Destination = "C:\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