patricktoulon
XLDnaute Barbatruc
Bonjour a tous
je n'ai rien trouver sur ce point je pose donc la question ; au cas ou :si quelqu'un sait
en effet je liste mes archives ZIP avec cette librairie avec une fonction récursive
tout fonctionne très bien dossiers /fichiers
sauf que quand un item de l'archive est aussi une archive elle est bien vu mais la récursivité de fonctionne pas
je n'ai pas d'erreur mais je n'est que l'item archive mais pas ces descendants
quelqu'un aurait une idée du problème
voici la fonction et ses subs de test
je n'ai rien trouver sur ce point je pose donc la question ; au cas ou :si quelqu'un sait
en effet je liste mes archives ZIP avec cette librairie avec une fonction récursive
tout fonctionne très bien dossiers /fichiers
sauf que quand un item de l'archive est aussi une archive elle est bien vu mais la récursivité de fonctionne pas
je n'ai pas d'erreur mais je n'est que l'item archive mais pas ces descendants
quelqu'un aurait une idée du problème
voici la fonction et ses subs de test
VB:
'**************************************************************
' Fonction ZipSearchLisT V 2.1
'Fonction pour lister le contenu d'une archive ZIP (!!!RECURSIVE!!!)(dossiers et sous dossiers)
'Version 2.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
'
'Mises à jour
'Date:28/08/2022
'Mode du test folder changé avec un vrai test folder
'
'Date:30/08/2022
'Version 2.1
'Date Version:30/08/2022
'Ajout du mode "argument optional modeList" (pour selectionner le mode de listage
'Restructuration du code dans un select case pour le modeList
'ajout du mode recursif boolean pour ne lister que la racine de l'archive ou son arborescence complete
'
'
'*************************************************************
Option Explicit
Function ZipSearchLisT(ByVal fichierZiP, _
Optional ByVal PartString$ = "*", _
Optional ByVal ModeList As Long = 3, _
Optional ByVal recursif As Boolean = True, _
Optional ByVal start As Boolean = True)
'ModeList = 1 uniquement les dossiers
'ModeList = 2 les dossiers et fichiers
'ModeList = 3 uniquement les fichiers
'
Dim Archiveur, FL, archive: Static tbl(): Static A&
If start = True Then Erase tbl: A = 0: archive = fichierZiP
Set Archiveur = CreateObject("Shell.Application")
For Each FL In Archiveur.Namespace(fichierZiP).Items
If FL.Path Like PartString Then
Select Case ModeList
Case 1
If FL.Type = "Dossier de fichiers" Then A = A + 1: ReDim Preserve tbl(1 To A): tbl(A) = FL.Path
Case 2
A = A + 1: ReDim Preserve tbl(1 To A): tbl(A) = FL.Path
Case 3
If FL.Type <> "Dossier de fichiers" Then A = A + 1: ReDim Preserve tbl(1 To A): tbl(A) = FL.Path
End Select
End If
'Appel recursif si c'est un dossier
If FL.Type = "Dossier de fichiers" And recursif Then ZipSearchLisT FL.Path, PartString, ModeList, recursif, False
' on renvoi aussi en récursif si c'est une archive
If FL.Type = "Dossier compressé" And recursif Then ZipSearchLisT FL.Path, PartString, ModeList, recursif, False
Next
Set Archiveur = Nothing
'dans une fonction recursive de recherche de dossiers/fichiers la fin est toujours la racine( le debut )
'pour eviter de recharger le return a chaque tour avec TBL afin de gagner un peu de memoire
'et donc accélérer le proccesus;on charge le return à la fin en controlant ou en est l'adresse de fichierZip
Debug.Print fichierZiP
If fichierZiP = archive Then ZipSearchLisT = tbl
End Function
'-------------------------------------------------------------------------------------
' ESSAYONS VOIR: TOUTES LES POSSIBILITES DE CETTE FONCTION
'ARBORESCENCE COMPLETE (DOSSIERS ET FICHIERS)
Sub Liste_Tout_Les_dossiers_et_tout_les_FichierZip()
Dim Lst
Lst = ZipSearchLisT("C:\Users\patrick\Desktop\Archive 2.zip", "*", 2, True)
[A1].Resize(65650).ClearContents
[A1].Resize(UBound(Lst)) = Application.Transpose(Lst)
End Sub
'SEULEMENT LES FICHIERS DANS TOUTE L ARBORESCENCE COMPLETE
Sub ListeToutLesFichiersDuZip()
Dim Lst
Lst = ZipSearchLisT("C:\Users\patrick\Desktop\sauvegarde Admin.zip", "*", 3)
[A1].Resize(65650).ClearContents
[A1].Resize(UBound(Lst)) = Application.Transpose(Lst)
End Sub
'LES FICHIERS AYANT L EXTENSION ".png" DANS L ARBORESCENCE COMPLETE
Sub Liste_Tout_Les_Fichiers_image_Png_Du_Zip()
Dim Lst
Lst = ZipSearchLisT("C:\Users\patrick\Desktop\sauvegarde Admin.zip", "*.png")
[A1].Resize(65650).ClearContents
[A1].Resize(UBound(Lst)) = Application.Transpose(Lst)
End Sub
'LES FICHIERS AYANT L EXTENSION ".png" A LA RACINE DE L'ARCHIVE(pas de récursivité)
Sub Liste_Tout_Les_Fichiers_image_Png_Racine_Du_Zip()
Dim Lst
Lst = ZipSearchLisT("C:\Users\patrick\Desktop\sauvegarde Admin.zip", "*.png", recursif:=False)
[A1].Resize(65650).ClearContents
[A1].Resize(UBound(Lst)) = Application.Transpose(Lst)
End Sub
'LES FICHIERS AYANT LEUR NOM TERMINANT PAR "avril"
Sub Liste_Tout_Les_Fichier_avec_nom_terminant_par_Avril()
Dim Lst
Lst = ZipSearchLisT("C:\Users\patrick\Desktop\sauvegarde Admin.zip", "*avril.*")
[A1].Resize(65650).ClearContents
[A1].Resize(UBound(Lst)) = Application.Transpose(Lst)
End Sub
'RECUPERE LE CHEMIN COMPLET D'UN OU DES DOSSIER(S) PORTANT UN NOM PRECIS
'(renvoie plusieurs si ils en existe plusieurs du meme nom )
Sub le_chemin_d_Un_dossier_avec_un_nom_precis()
Dim Lst, NomDossier$
NomDossier = "*\planning futur"
Lst = ZipSearchLisT("C:\Users\patrick\Desktop\sauvegarde Admin.zip", NomDossier, 1)
[A1].Resize(65650).ClearContents
[A1].Resize(UBound(Lst)) = Application.Transpose(Lst)
End Sub
'LISTE TOUT LES FICHIERS DANS UN DOSSIER PORTANT UN NOM PRECIS (cherche aussidans ses sous dossier )
Sub fichiers_dans_dossier_precis()
Dim Lst, NomDossier$
NomDossier = "*\planning futur\*"
Lst = ZipSearchLisT("C:\Users\patrick\Desktop\sauvegarde Admin.zip", NomDossier)
[A1].Resize(65650).ClearContents
[A1].Resize(UBound(Lst)) = Application.Transpose(Lst)
End Sub
'LISTE TOUT LES FICHIER AYANT UNE EXTENSION PRECISE DANS UN DOSSIER PRECIS ET SES SOUS DOSSIERS
Sub fichiers_PDF_dans_dossier_precis()
Dim Lst
Lst = ZipSearchLisT("C:\Users\patrick\Desktop\sauvegarde Admin.zip", "*\mars\*.pdf")
[A1].Resize(65650).ClearContents
[A1].Resize(UBound(Lst)) = Application.Transpose(Lst)
End Sub
