zip d'un fichier

Sub ZipFichier()
    '
    'Source
    'http://www.codecomments.com/archive299-2006-2-295877.html
    '
    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