zip And unzip des éléments d'un fichier de type zip y compris les fichiers Excelavec la commande (TAR)

Sub Test_FileExtraction()
    fic = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", 1, "Sélectionner un fichier Excel")
    If fic = "Faux" Then Exit Sub
    fichier = "customUI/customUI14.xml"
    dest = ThisWorkbook.Path & "\customUI14.xml"
    fichier = FileExtraction(fic, fichier, dest)
End Sub

Sub Test2_FileExtraction()
    fic = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", 1, "Sélectionner un fichier Excel")
    If fic = "Faux" Then Exit Sub
    fichier = "xl/workbook.xml"
    dest = ThisWorkbook.Path & "\workbook.xml"
    fichier = FileExtraction(fic, fichier, dest)
End Sub

Function FileExtraction(Filepath, extractedFile, direction)
    Set objShell = CreateObject("WScript.Shell")
    objShell.Run "cmd /c tar -xOf """ & Filepath & """ " & extractedFile & " > """ & direction & """", 0, True
    Set objShell = Nothing
    If Dir(direction) <> "" Then FileExtraction = Destination Else FileExtraction = False
End Function

Sub Test_Folder_Extraction()
    fic = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", 1, "Sélectionner un fichier Excel")
    If fic = "Faux" Then Exit Sub
    'folder = "customUI/" 'extraction du dossier customUi et tout son contenu
    folder = "customUI/images" 'extraction du dossier customUI avec juste son dossier images
    dest = ThisWorkbook.Path
    folder = FolderExtraction(fic, folder, dest)
End Sub

Function FolderExtraction(Filepath, ExtractedFolder, direction)
    Set objShell = CreateObject("WScript.Shell")
    objShell.Run "cmd /c tar -xf """ & Filepath & """ -C """ & direction & """ " & ExtractedFolder & "/", 0, True
    Set objShell = Nothing
    If Dir(direction & "\" & Replace(ExtractedFolder, "/", "\"), vbDirectory) <> "" Then FolderExtraction = direction Else FolderExtraction = False
End Function

Sub test_ExtractAllInFile()
    fic = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", 1, "Sélectionner un fichier Excel")
    If fic = "Faux" Then Exit Sub
    ExtractAllInFile fic, ThisWorkbook.Path & "\mondossier"
End Sub

Function ExtractAllInFile(Filepath, direction)
    If Dir(direction, vbDirectory) = "" Then MkDir direction
    Set objShell = CreateObject("WScript.Shell")
    objShell.Run "tar -xf """ & Filepath & """ -C """ & direction & """", 0, True
    Set objShell = Nothing
End Function

Sub test_ArborescenceZipList()
    Dim x As Variant, fic As String
    fic = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", 1, "Sélectionner un fichier Excel")
    If fic = "Faux" Then Exit Sub
    ' x = ArborescenceZipListv2(fic)'sans filtre
    ' x = ArborescenceZipListv2(fic, "customUI/") 'filtre dossier
    x = ArborescenceZipListv2(fic, "customUI") 'filtre tout ce qui contient customUI
    If IsArray(x) Then Debug.Print Join(x, vbCrLf)
End Sub

Function ArborescenceZipList(Filepath As String, Optional Filter As String = "") As Variant
    Dim objShell As Object, objExec As Object, cmdList As String, line As String, results() As String, A As Long
    Set objShell = CreateObject("WScript.Shell")
    ' concat de la commande avec ou sans filtre de dossier
    If Len(Filter) > 0 Then
        cmdList = "cmd /c tar -tf """ & Filepath & """ | findstr """ & Filter & """"
    Else
        cmdList = "cmd /c tar -tf """ & Filepath & """"
    End If
    Set objExec = objShell.exec(cmdList)
    ' Lecture des résultats
    Do While Not objExec.StdOut.AtEndOfStream
        line = objExec.StdOut.ReadLine
        A = A + 1: ReDim Preserve results(1 To A): results(A) = line
    Loop
 
    If A > 0 Then
        ArborescenceZipList = results
    Else
        ArborescenceZipList = False
    End If
End Function

Sub test_ArborescenceZipListv2()
    Dim x As Variant, fic As String
    fic = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", 1, "Sélectionner un fichier Excel")
    If fic = "Faux" Then Exit Sub
    MsgBox fic
    x = ArborescenceZipListv2(fic) 'sans filtre
    ' x = ArborescenceZipListv2(fic, "customUI/") 'filtre dossier
    ' x = ArborescenceZipListv2(fic, "customUI") 'filtre tout ce qui contient le mot "customUI"
    If Not IsEmpty(x) Then Debug.Print Join(x, vbCrLf)
End Sub

Function ArborescenceZipListv2(Filepath As String, Optional Filter As String = "") As Variant
    Dim tempFile As String, cmdList As String, objShell As Object, f As Integer, lachaine As String, T As Variant
    ' Fichier temporaire
    tempFile = Environ$("TEMP") & "\tarlist.txt"
    If Dir(tempFile) <> "" Then Kill tempFile
 
    ' concat de  la commande tar + findstr
    If Len(Filter) > 0 Then
        cmdList = "cmd /c tar -tf """ & Filepath & """ | findstr """ & Filter & """ > """ & tempFile & """"
    Else
        cmdList = "cmd /c tar -tf """ & Filepath & """ > """ & tempFile & """"
    End If
 
    ' Exécuter en masqué
    Set objShell = CreateObject("WScript.Shell")
    objShell.Run cmdList, 0, True
    Set objShell = Nothing
 
    ' Lire le tempFile dans un tableau
    If Dir(tempFile) <> "" Then
        f = FreeFile: Open tempFile For Binary Access Read As #f: lachaine = String(LOF(f), " "): Get #f, , lachaine: Close #f
        Kill tempFile
        T = Split(lachaine, vbCrLf)
        If Len(T(UBound(T))) = 0 Then ReDim Preserve T(UBound(T) - 1)
    End If
    ' Retourner un tableau si trouvé
    If UBound(T) > 0 Then
        ArborescenceZipListv2 = T
    Else
        ArborescenceZipListv2 = Empty
    End If
End Function

Sub Test_ZipFileOrFolder()
    Dim SourcePath As String, zipPath As String
    ' Choisir le fichier ou dossier à zipper
    SourcePath = Application.GetOpenFilename("Tous fichiers (*.*), *.*", , "Sélectionner un fichier à zipper")
    If SourcePath = "False" Then Exit Sub
    zipPath = ThisWorkbook.Path & "\monArchive.zip" ' chemin du ZIP de destination
    If ZipFileWithTar(SourcePath, zipPath) Then ' Appel de la fonction
        MsgBox "ZIP créé : " & zipPath
        Else: MsgBox "Erreur lors de la création du ZIP"
    End If
End Sub

Function ZipFileWithTar(SourcePath As String, ZipDestination As String) As Boolean
    Dim objShell As Object, cmd As String
    Set objShell = CreateObject("WScript.Shell")
    'a garder comme exemple simple
    cmd = "cmd /c tar -a -cf """ & _
           ZipDestination & """ -C """ & _
           Mid(SourcePath, 1, InStrRev(SourcePath, "\") - 1) & """ """ & _
           Mid(SourcePath, InStrRev(SourcePath, "\") + 1) & """"
    On Error Resume Next
    ' Exécuter la commande masquée
    Set objShell = CreateObject("WScript.Shell")
    objShell.Run cmd, 0, True
    Set objShell = Nothing
    ZipFileWithTar = Dir(ZipDestination) <> ""
End Function