Envoyer vers fichier compressé

Bonjour,

Quelle est l'instruction VBA qui permet de compresser plusieurs fichiers ( par ex *.htm) vers un seul fichier compressé (par ex COMPR.zip).

Merci

Bonsoir

Voici une base de recherche :

Option Explicit

Sub ZipFichier()
Dim oShell As Object
Dim FSO As Object
Dim i As Long
Dim sFichier As String, sBin As String
Dim sZip As Variant, vHexa As Variant

    sFichier = ThisWorkbook.Path & "\" & "Essai.xls" ' sera a ne plus utiliser car bouclé plus bas
    sZip = ThisWorkbook.Path & "\" & "Essai.zip"

    Set FSO = CreateObject("Scripting.FileSystemObject" )
    vHexa = 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(vHexa)
        sBin = sBin & Chr(vHexa(i))
    Next i

    With FSO.CreateTextFile(sZip, True)
        .Write sBin
        .Close
    End With

    Set oShell = CreateObject("Shell.Application" )
    oShell.Namespace(sZip).CopyHere (sFichier)

    Set oShell = Nothing
    Set FSO = Nothing
End Sub

2 choses à modifier:

Il faudrait boucler ici avec une sorte de For each file dans une directory dédié avec une extension si besoin

Dim Nom_proj(300)
chemin = "C:\"
Direction = Dir(chemin & "\*.xls")
nbfic = 0
While Direction > ""
nbfic = nbfic + 1
Nom_proj(nbfic) = Direction

 oShell.Namespace(sZip).CopyHere (chemin & Nom_proj(nbfic))

Direction = Dir()
Wend
For x = 1 To nbfic
Fg = Nom_proj(x)
Next x
End Sub

Donc dans le premier code il faut substituer

oShell.Namespace(sZip).CopyHere (sFichier)

par le deuxieme code inseré dans mon post

Cdt,