XL 2021 Compresser le contenu d'un dossier en zip

Sub RunZip()
   ' Nota: le Confirm est crispant , l'enlever en fin de test
    Shell "powershell.exe """ & _
        " $Folder = 'D:\Users\.....\Downloads\Sources à Importer';" & _
        " $Target = 'D:\Users\.....\Downloads\Target.zip';" & _
        " Compress-Archive " & _
            " -Path $Folder" & _
            " -DestinationPath $Target" & _
            " -Force " & _
            " -Confirm ;" & _
        " explorer.exe /select,$Target ;" & _
        " Read-Host 'Appuyez sur ENTREE pour continuer...'" & _
        """", vbMaximizedFocus
End Sub

Sub ZipRepertoire()
    '
    'Source
    'http://www.codecomments.com/archive299-2006-2-295877.html
    '
    Const ForReading = 1, ForWriting = 2, ForAppending = 8
    
    Dim Source, Destination, MyHex, MyBinary, i
    Dim oShell, oApp, oFolder, oCTF, oFile
    Dim oFileSys
    
    'Spécifiez le répertoire
    Source = "C:\Le répertoire"
    Destination = "C:\maSauvegarde.zip"
    
    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
    
    Set oShell = CreateObject("WScript.Shell")
    Set oFileSys = CreateObject("Scripting.FileSystemObject")
    
    'Création de la base du fichier zip.
    Set oCTF = oFileSys.CreateTextFile(Destination, True)
    oCTF.Write MyBinary
    oCTF.Close
    Set oCTF = Nothing
    
    Set oApp = CreateObject("Shell.Application")
    
    Set oFolder = oApp.Namespace(Source)
    If Not oFolder Is Nothing Then _
        oApp.Namespace(Destination).CopyHere oFolder.Items
    
    Set oFile = Nothing
    On Error Resume Next
    
    Do While (oFile Is Nothing)
        'Attention: provoque une erreur 70 si un des fichiers à zipper
        'est toujours ouvert.
        Set oFile = oFileSys.OpenTextFile(Destination, ForAppending, False)
        
        If Err.Number <> 0 Then
            Err.Clear
        End If
    Loop
    
    Set oFile = Nothing
    Set oFileSys = Nothing
End Sub