'**************************************************************
' Fonction ZipSearchLisT
'Fonction pour lister le contenu d'une archive ZIP (!!!RECURSIVE!!!)(dossiers et sous dossiers)
'Version 1.0
'Date Version:28/08/2022
'Auteur:patricktoulon
'liste tout des fichier avec part of string
'liste fichier avec extension
'liste les fichier d'un dossier precis
'*************************************************************
Option Explicit
Function ZipSearchLisT(fichierZiP, Optional ByVal PartString$ = "*", Optional start As Boolean = True)
Dim Archiveur, FL
Static texte$
If start = True Then texte = ""
Set Archiveur = CreateObject("Shell.Application")
For Each FL In Archiveur.Namespace(fichierZiP).Items
If FL.Path Like PartString Then texte = texte & FL.Path & vbCrLf
If Not Right(FL.Path, 4) Like ".*" Then ZipSearchLisT FL.Path, PartString, False
Next
Set Archiveur = Nothing
ZipSearchLisT = Split(texte, vbCrLf)
End Function
'-------------------------------------------------------------------------------------
' ci dessous ;Les subs de Tests
Sub ListeToutLeFichieZip() 'arborescence complete
Dim Lst
Lst = ZipSearchLisT("C:\Users\patrick\Desktop\Archive.zip", "*")
MsgBox Join(Lst, vbCrLf)
End Sub
Sub ListeToutLesFichier() 'les fichiers ayant l'extension ".png" dans le path complet
Dim Lst
Lst = ZipSearchLisT("C:\Users\patrick\Desktop\Archive.zip", "*.png")
MsgBox Join(Lst, vbCrLf)
End Sub
Sub ListeToutLesFichier2() 'les fichiers ayant le nom terminant par "2" avec l'extension ".png"
Dim Lst
Lst = ZipSearchLisT("C:\Users\patrick\Desktop\Archive.zip", "*2.png")
MsgBox Join(Lst, vbCrLf)
End Sub
Sub Un_dossier_precis()
Dim Lst
Lst = ZipSearchLisT("C:\Users\patrick\Desktop\Archive.zip", "*\media")
MsgBox Join(Lst, vbCrLf)
End Sub
Sub fichiers_dans_dossier_precis()
Dim Lst
Lst = ZipSearchLisT("C:\Users\patrick\Desktop\Archive.zip", "*\media\*")
MsgBox Join(Lst, vbCrLf)
End Sub