[vba basic]存档/压缩程序

Posted 2021-02-22

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

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:TestMonFichierWord.docx"
    FichierZip = "C:TestArchivesMonArchive_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