Sub ArchiverUnFichier()
'par Excel-Malin.com ( https://excel-malin.com )
'---------------------------------------------------------
'gestion des erreurs
    On Error GoTo ErreurCompression

'définition des variables
    Dim ApplicationArchivage As Object
    Dim FichierAArchiver, FichierZip
       
'informations sur les fichiers (chemins & noms)
    FichierAArchiver = "C:\Test\MonFichierWord.docx"
    FichierZip = "C:\Test\Archives\MonArchive_1.zip"
     
'créer un nouveau archive
    If Len(Dir(FichierZip)) > 0 Then Kill FichierZip 'supprime l'archive s'il existe déjà
    Open FichierZip For Output As #1
        Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
    Close #1
      
'copier le fichier à archiver dans l'archive
    Set ApplicationArchivage = CreateObject("Shell.Application")
    ApplicationArchivage.Namespace(FichierZip).CopyHere FichierAArchiver

'Message final
    MsgBox "L'archivage a été lancé..."

Exit Sub
ErreurCompression:
    MsgBox "Une erreur s'est produite..."
End Sub

Il suffit d'indiquer le nom du fichier à archiver et le nom de l'archive. Par défaut, si l'archive mentionné existe déjà, la macro va l'effacer avant de le recréer.

Archive / compress a file with VBA

[vba-basic] Archiver/compresser un fichier avec VBA

files

Visual Basic