Sub ZipFichier()
Dim oShell As Object, Fso As Object
Dim i As Long
Dim Fichier As String, MyBinary As String
Dim LeZip As Variant, MyHex As Variant
Fichier = ThisWorkbook.Path & "\Essai.xls"
LeZip = ThisWorkbook.Path & "\Essai.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 i
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 |