XL 2013 la librairie shell and automation de Microsoft a t elle des limites

patricktoulon · 5 Septembre 2022

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

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

Laurent_ott · 6 Septembre 2022

patricktoulon à dit:

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

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

Laurent_ott · 6 Septembre 2022

Bonjour,
Vous trouverez la réponse à vos questions (je l'espère) en lisant cette documentation :

Compresser/décompresser des fichiers au format ZIP

laurent-ott.developpez.com

Principalement au chapitre 2.
Cordialement.

patricktoulon · 6 Septembre 2022

Bonjour @Laurent_ott
merci pour le retour
mais je crains fort d’être dans le flou et que ce chapitre 2 ne me renseigne pas plus
j'ai bien lu les paragraphes

Remarque : Element.Path inclut l’adresse de l’archive ZIP. Par exemple, le fichier « Alice.xls » contenu dans l’archive « C:\MesArchives\MonFichier.Zip » sera renseigné : « C:\MesArchives\MonFichier.Zip\Alice.xls ». Il conviendra donc d’ôter l’adresse de l’archive pour avoir le chemin réel et le nom du fichier, soit dans cet exemple « \Alice.xls ».

mon problème concerne une archive dans une archive
lister le reste dans une fonction récursive n'est pas un soucis elle fonctionne très bien la mienne
le soucis c'est qu'a un moment donné j'arrive à

c:\users\patrick\Desktop\monarchive.zip\ monautrearchivealinterieur.zip"
il est bien listé mais dans la récursivité il passe a l'item suivant au lie de lister son interieur comme ca liste les dossiers

pourtant il est bien précisé dans l'appel recursif

VB:

 '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

si tu a une solution je prends bien évidement
merci

Laurent_ott · 6 Septembre 2022

Bonjour,
Je n'avais pas saisi le problème, désolé.
Une idée (que je n'ai pas testée) : détacher le ZIP du ZIP dans un répertoire temporaire, puis le lire.
Cordialement.

patricktoulon · 6 Septembre 2022

re
oui je pense que c'est la seule solution
ça va être compliqué pour fake treeview
qui est basé sur une lecture linaire et basé sur le chemin précédent
en l’état mon pseudo treeview

XL 2013 la librairie shell and automation de Microsoft a t elle des limites

patricktoulon

XLDnaute Barbatruc

Laurent_ott

XLDnaute Nouveau

Laurent_ott

XLDnaute Nouveau

Compresser/décompresser des fichiers au format ZIP

patricktoulon

XLDnaute Barbatruc

Laurent_ott

XLDnaute Nouveau

patricktoulon

XLDnaute Barbatruc

Discussions similaires