compresser un dossier

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

bonjour

j'espere que ces infos pourront t'aider

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
'
'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

bonne soiree
michel

Oouuppss....

j'ai oublié de préciser que ça fonctionne aussi en VBA, il suffit d'enlever les lignes

Code:

wScript.Sleep ...

(testé avec WinXP & Excel2002)

bonne soiree
michel

Merci beaucoup !
nickel ;)