Autres je n'arrive pas a extraire les éléments d'une archive

patricktoulon

XLDnaute Barbatruc
bonjour a tous
je n'arrive pas a extraire les éléments d'une archive vers un dossiers

VB:
Sub test()
    Dim sh, sampleC$, sampleZip$, i , n
    
      
    sampleC = ThisWorkbook.Path & "\toto.xlsm"
    sampleZip = ThisWorkbook.Path & "\toto.zip"
    decompil = ThisWorkbook.Path & "\decompilation"
    
    If Dir(sampleZip) <> "" Then Kill sampleZip

    With Workbooks.Add: .SaveAs Filename:=sampleC, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False: .Close: End With
    Application.ScreenUpdating = True
    Do While Dir(sampleC) = "": DoEvents: Loop    'attente creation
    Name sampleC As sampleZip    'conversion en archive ZIP
    Do While Dir(sampleZip) = "": DoEvents: Loop


 Set sh = CreateObject("shell.application")
 
    'sh.Namespace(decompil).movehere sh.Namespace(sampleZip).items.Item("_rels")'fonctionne pas
    Set n = sh.Namespace(sampleZip)
    For Each i In n.items ' ici ça plante
        Debug.Print i.Path
    Next
End Sub
puré je m'arrache les cheveux
 
Solution
Bonjour Patrick,
je suis pas certain d'avoir compris!

Code de kiki29!
Code:
 Option Explicit
 
Sub Unzip()
Dim FSO As Object
Dim oApp As Object
Dim DossierZip As Variant
Dim DossierDezip As Variant
    
    DossierZip = ThisWorkbook.Path & "\toto.zip"
    DossierDezip = ThisWorkbook.Path & "\Data"
 
    Set FSO = CreateObject("Scripting.FileSystemObject")
    If FSO.FolderExists(DossierDezip) Then
        FSO.DeleteFile DossierDezip & "\*.*", True
        FSO.DeleteFolder DossierDezip & "\*.*", True
    End If
    Set FSO = Nothing
 
    If CreationDossier(DossierDezip) Then
 
        Set oApp = CreateObject("Shell.Application")
        oApp.Namespace(DossierDezip).CopyHere oApp.Namespace(DossierZip).items
        Set oApp = Nothing...

patricktoulon

XLDnaute Barbatruc
bon j'ai pris la résolution de @dysorthographie
sur la base de son principe j'extrais TOUT!!! du classeur zipper dans le dossier data et je travaille dans ce dossier et a la fin je re transfert tout d'un coup aussi dans l'archive et !!!!!!!! jackpot!!!!

donc voila la sub de compilation
je devrais pas trop galérer pour adapter a mon creator
reste plus qu'a ouvrir le sample xlsm il a son ribbon

demo7.gif
 

Pièces jointes

  • testdezipeur.zip
    72.5 KB · Affichages: 6
Dernière édition:

patricktoulon

XLDnaute Barbatruc
Bonsoir ChTi160
a ben j'ai déjà bien avancé il est déjà fonctionnel pour les onglets,group , box vertical , box horizontal ,, bouton , separator , les dynamicMenu
il me compile déjà le tout avec les deux customUI pour (2007/ et plus) avec ou sans icon perso/imagemso
il me genere aussi les callback
me reste a faire les gallery en dur en en dynamic
j'en ai déjà fait 4 ou 5 ;)
ca fait un moment que j'avais eu lidée mais la flemme de m y mettre là je suis aller au bout
et comme je suis gentil et que je pense a tous il y a une version sans listview pour ceux qui ne veulent pas l'utiliser ou ne l'ont pas je le remplace par un faux dialog responsif (ma spécialité);)
on peut deja voir que je n'ai pas utiliser non plus de treeview certains ne l'ont pas la aussi j'ai utilisé une frame avec controls dynamiques
bref j'ai bien avancé et il fonction a 100% pour la compilation