Création d'un zip via la commande Windows

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

Sub Zip_File_Or_Files()
    Dim strDate As String, DefPath As String, sFName As String
    Dim oApp As Object, iCtr As Long, I As Integer
    Dim FName, vArr, FileNameZip
 
    DefPath = "Y:\TestZip\Nouveau dossier"
    If Right(DefPath, 1) <> "\" Then
        DefPath = DefPath & "\"
    End If
 
    strDate = Format(Now, " dd-mmm-yy h-mm-ss")
    FileNameZip = DefPath & "MyFilesZip " & strDate & ".zip"
 
    'Browse to the file(s), use the Ctrl key to select more files
    FName = Application.GetOpenFilename(filefilter:="Excel Files (*.xls), *.xls", _
                                        MultiSelect:=True, Title:="Select the files you want to zip")
    If IsArray(FName) Then
        'Create empty Zip File
        NewZip (FileNameZip)
        Set oApp = CreateObject("Shell.Application")
        I = 0
        For iCtr = LBound(FName) To UBound(FName)
            vArr = Split(FName(iCtr), "\")
            sFName = vArr(UBound(vArr))
            I = I + 1
            oApp.Namespace(FileNameZip).CopyHere (FName(iCtr))
        Next iCtr
 
        'Keep script waiting until Compressing is done
        On Error Resume Next
        Do Until oApp.Namespace(FileNameZip).items.Count = I
            DoEvents
        Loop
 
        MsgBox "You find the zipfile here: " & FileNameZip
        On Error GoTo 0
        Set oApp = Nothing
    End If
End Sub
Sub NewZip(sPath)
'Create empty Zip File
'Changed by keepITcool Dec-12-2005
    If Len(Dir(sPath)) > 0 Then Kill sPath
    Open sPath For Output As #1
    Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
    Close #1
End Sub

Array(80, 75, 5, 6, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0