Compresser un fichier par macro

jeanmomo

XLDnaute Nouveau
Bonjour à tous,

Je souhaite compresser un fichier excel par l'éditeur de compression de Windows, et ceci grâce à une macro.

Ce fichier base.xls se situe dans C:\base.xls, et je souhaiterais que la macro l'enregistre au format.zip dans D:\base.zip.


Quelqu'un aurait-il une idée de code vba pour ceci?

Merci d'avance.
 

jeanmomo

XLDnaute Nouveau
Re : Compresser un fichier par macro

Merci pour ton aide.

J'ai essayé avec le dernier lien (zipper un fichier), mais sur la deuxième du code ci-dessous, il m'indique une erreur de type "13" et une incompatibilité de type.

For i = 0 To UBound(MyHex)
MyBinary = MyBinary & Chr(MyHex(i))
Next



En supprimant ces lignes, il arrive à la compression (je vois la fenêtre de compression apparaître), mais pour la ligne ci-dessous:

Set oShell = Nothing

il m'indique que le dossier compressé n'est pas valide ou qu'il est endommagé.

As-tu une idée de la correction a apporter?

Merci.
 

kiki29

XLDnaute Barbatruc
Re : Compresser un fichier par macro

Re, ce code fonctionne sans aucun probleme sur mon PC, donc à priori tu ne l'utilises pas correctement
Code:
Option Explicit

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:\Base.xls"
    LeZip = "D:\Base.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
 
Dernière édition:

Discussions similaires