XL 2016 VBA - Trouver les feuilles d'un classeur fermé

[Dudu2]

Bonjour,

J'ai bien une fonction pour trouver les valeurs d'une feuille donnée d'un classeur fermé (fichier joint) mais je n'ai rien pour trouver les noms des feuilles de ce classeur fermé.

Merci par avance.

 

[nullosse]

Salut,
j'ai le même problème que Dudu2 sous Windows 11 "Erreur d'execution '9' :
C'est parce que le fichier n'a pas une extension .zip : si je copie le classeur1.xlsx en classeur1.zip et que je teste avec ce fichier, cela fonctionne.
L' "I.A" m'indique ceci :

• Sur certains systèmes, .xlsx est associé à Explorer comme archive → Namespace() fonctionne.
• Sur d’autres systèmes, l’association n’existe pas → Namespace() échoue.
• Dépend aussi de Windows 10 vs 11, des paramètres régionaux, et des applications par défaut pour les ZIP.

pour décompresser on peut aussi utiliser la commande tar qui est présente dans windows 11 et dans les dernières versions de windows 10.
Et pour le fun, lire les noms des feuilles avec powershell à partir de VBA :

Sub LireFeuillesXLSX_PowerShell()
    Dim xlsxPath As String, psCommand As String
    Dim objShell As Object, execObj As Object, output As String  
    ' Chemin du fichier Excel
    xlsxPath = "C:\Excel\classeur1.xlsx"   
    ' Commande PowerShell multi-lignes (ici avec tar)
    psCommand = "$temp = Join-Path $env:TEMP ([guid]::NewGuid());" & _
                "New-Item -ItemType Directory -Path $temp | Out-Null;" & _
                "tar -xf '" & xlsxPath & "' -C $temp 'xl/workbook.xml';" & _
                "[xml]$xml = Get-Content (Join-Path $temp 'xl/workbook.xml');" & _
                "$xml.workbook.sheets.sheet.name;" & _
                "Remove-Item -Recurse -Force $temp"  
    ' Créer l'objet Shell
    Set objShell = CreateObject("WScript.Shell")   
    ' Exécuter PowerShell et récupérer stdout
    Set execObj = objShell.Exec("powershell -NoProfile -Command """ & psCommand & """")   
    ' Lire la sortie ligne par ligne
    output = ""
    Do While Not execObj.StdOut.AtEndOfStream
        output = output & execObj.StdOut.ReadLine & vbCrLf
    Loop   
    ' Afficher les noms des feuilles
    MsgBox output
End Sub

C'est assez long à s'exécuter à cause du chargement du Powershell.

Nullosse

 

[patricktoulon]

Bonjour @nullosse
en effet c'est long @laurent950 nous a proposé quelque chose de plus court avec powershell et en invisible

• Sur certains systèmes, .xlsx est associé à Explorer comme archive → Namespace() fonctionne.
• Sur d’autres systèmes, l’association n’existe pas → Namespace() échoue.
• Dépend aussi de Windows 10 vs 11, des paramètres régionaux, et des applications par défaut pour les ZIP

en fait tu la posé la mauvaise question
le sujet n'est pas l'association puisque par vba on change l'extension donc c'est bien un zip
et l'explorer le lit très bien comme dossier compressé dans l'explorer

le probleme c'est les latences sur W11 qu'il faut gérer

 

[patricktoulon]

re
je viens de tester avec le chemin vers le dossier temp à la place de thisworkbook.path ,et j'ai exactement la même erreur que @Dudu2
1° la demande de remplacement (ca veut dire que le kill recentrent n'a pas fait son travail
2° forcement l'erreur d'indice qui n’appartient pas a la sélection

c'est donc bien pour moi un soucis d'autorisation et/ou de latence d'accès lecture/ecriture du dossier
chez moi c'est quasi instantané

Option Explicit

Sub testFX()
    Dim ListSheet, FilePath$
    'adapter le chemin ici ou injecter un dialog getopenfilename
    FilePath$ = "C:\Users\patricktoulon\Desktop\Classeur1.xlsx"
    ListSheet = ListSheetOnClosedFileXML(FilePath)
    MsgBox Join(ListSheet, vbCrLf)
End Sub
Function ListSheetOnClosedFileXML(lPath As String)
    Dim Archiveur, fichierZiP$, fichierxml$, xDoc As Object, noeud, TbL(), A&, X&
    ReDim Preserve TbL(1 To 300)
    'les chemins de fichiers
    fichierZiP = Left(lPath, InStrRev(lPath, ".")) & "zip"
    fichierxml = Mid(lPath, 1, InStrRev(lPath, "\")) & "workbook.xml"
    
    'on les supprimes si ils existent
    If Dir(fichierZiP) <> "" Then Kill fichierZiP
    Do While Dir(fichierZiP) <> "": DoEvents: Loop
    If Dir(fichierxml) <> "" Then Kill fichierxml
    Do While Dir(fichierxml) <> "": DoEvents: Loop
  
    'on copie le fichier Excel(xlsx , xlsm , xlt , xlb) en format zip
    FileCopy lPath, fichierZiP
    Do While fichierZiP = "": DoEvents: Loop
    
    'on ouvre un object shell.application
    Set Archiveur = CreateObject("Shell.Application")
    DoEvents
    
    'on sort en accès direct le fichier  voulu  en l'occurrence ici le workbook.xml qui se trouve dans
    'fichierZiP & "\xl\workbook.xml"
    With Archiveur
        .Namespace(ThisWorkbook.Path).copyhere .Namespace(fichierZiP & "\xl\").Items.Item("workbook.xml")
    End With
    
    ' Charger le XML
    Set xDoc = CreateObject("MSXML2.DOMDocument.6.0")
    xDoc.async = False
    xDoc.Load fichierxml
    
    ' Ajouter espace de noms pour les feuilles
    xDoc.SetProperty "SelectionNamespaces", "xmlns:ss='http://schemas.openxmlformats.org/spreadsheetml/2006/main'"
    
    ' Parcourir les feuilles en mode Xpath
    For Each noeud In xDoc.SelectNodes("//ss:sheet")
        A = noeud.getattribute("sheetId")
        TbL(A) = noeud.Attributes.getNamedItem("name").Text
        If A > X Then X = A
    Next
    ReDim Preserve TbL(1 To X)
    'on  supprime zip et xml on en a plus besoin
    If Dir(fichierZiP) <> "" Then Kill fichierZiP
    If Dir(fichierxml) <> "" Then Kill fichierxml
    
    ListSheetOnClosedFileXML = TbL
End Function

 

[Dudu2]

Bonjour la liste,
Je suppose que ce dernier code est le même qu'avant car j'ai toujours les mêmes problèmes.
J'utiliserais bien le code de @laurent950 mais je n'ai pas autorisé PowerShell sur mon PC et faut faire des manips pour.
Pas moyen de convertir ce PowerShell en Shell ?

 

[patricktoulon]

Pas moyen de convertir ce PowerShell en Shell ?

et ben c'est shell.automation
c'est ce que j'utilise
si tu es sur win 11 et que tu tourne sur un compte autre que ton compte microsoft (donc un compte local)et que tu n'a pas pris les droits administrateur
tu a plein de choses qui sont bloquées
c'est pareil que sur win 10 mais en plus compliqué sur win 11 me semble t il

comme tu peux le voir je suis sur un compte local"patricktoulon" mais en administrateur total

essaie ceci juste pour controler si tu bien tout les droit

sinon reste avec ado la dernière version que je t'ai donné supprime les doublon et parasite par filter
affaire à suivre si d'autres artefacts parasites viennent troubler la lecture du recordset
par contre pour l'ordre exact des feuilles , c'est confirmé avec ado c'est mort

 

[Dudu2]

Suis sur Windows 10 64 bits et Excel 2016 32 bits (mon laptop de vacances).

 

[patricktoulon]

ok en compte local ou microsoft?
si compte local a tu bien pris tout les droits?

 

[Dudu2]

Compte local.
Le compte est Admin.

 

[nullosse]

Et voici un code qui utilise le tar pour la décompression et le javascript (via l'objet HTMLFile) pour l'analyse du xml . Le DomParser du javascript est plus complet que celui du VBA.

Sub LireFeuillesXLSX_JS()
    Dim xlsxPath As String, tempFolder As String, xmlPath As String
    Dim fso As Object, html As String, xmlContent As String
    Dim cmd As String, objShell As Object, doc As Object, outStr
    Dim result As Variant
    ' Chemin de ton fichier Excel fermé
    'xlsxPath = "C:Excel\Test Case #4.xlsx"
    xlsxPath = "C:\Excel\classeur1.xlsx"
    ' Dossier temporaire
    tempFolder = Environ("TEMP") & "\" & CreateObject("Scripting.FileSystemObject").GetTempName
    MkDir tempFolder
    xmlPath = tempFolder & "\xl\workbook.xml"
    ' --- Étape 1 : Extraction de workbook.xml avec tar ---
    cmd = "tar -xf """ & xlsxPath & """ -C " & tempFolder & " xl/workbook.xml"
    Set objShell = CreateObject("WScript.Shell")
    result = objShell.Run(cmd, 0, True)
    ' --- Étape 2 : Lire workbook.xml ---
    Set fso = CreateObject("Scripting.FileSystemObject")
    If Not fso.FileExists(xmlPath) Then
        MsgBox "Impossible d'extraire workbook.xml", vbCritical
        Exit Sub
    End If
    xmlContent = fso.OpenTextFile(xmlPath, 1).ReadAll
    ' --- Étape 3 : Créer la page HTML + JS ---
    html = "<html><head><script>" & vbCrLf & _
           "function getSheetNames(xmlString) {" & vbCrLf & _
           "  var parser = new DOMParser();" & vbCrLf & _
           "  var xmlDoc = parser.parseFromString(xmlString, 'text/xml');" & vbCrLf & _
           "  var sheets = xmlDoc.getElementsByTagName('sheet');" & vbCrLf & _
           "  var names = [];" & vbCrLf & _
           "  for (var i=0; i<sheets.length; i++) {" & vbCrLf & _
           "    names.push(sheets[i].getAttribute('name'));" & vbCrLf & _
           "  }" & vbCrLf & _
           "  return names.join('\n');" & vbCrLf & _
           "}" & vbCrLf & _
           "</script></head><body></body></html>"
    ' --- Étape 4 : Charger le HTML
    Set doc = CreateObject("htmlfile")
    doc.Open
    doc.Write html
     ' --- Étape 5 : Appeler la fonction JS ---
    outStr = doc.parentWindow.getSheetNames(xmlContent)   ' appel JS
    doc.Close
    ' --- Afficher ---
    MsgBox outStr
    ' --- Nettoyage ---
    On Error Resume Next
    fso.DeleteFolder tempFolder, True: Set objShell = Nothing: Set doc = Nothing: Set fso = Nothing
End Sub

Avec les classeurs de Dudu2 c'est quasiment instantané chez moi en Windows 11 Excel 2016

 

[patricktoulon]

 

[Dudu2]

@nullosse, une petite correction sur result = (resultat =) ça fonctionne sans problème.
Je suis impressionné par ce code qui pour moi relève de la 4ème dimension.

 

[nullosse]

@nullosse, une petite correction sur result = (resultat =) ça fonctionne sans problème.
Je suis impressionné par ce code qui pour moi relève de la 4ème dimension.

voilà c'est corrigé dans mon code.
et pour patricktoulon, je n'ai essayé qu'en Windows 11 . Peut-être mettre le doc.close après l'utilisation de doc pour outStr (corrigé dans mon code).

 

[patricktoulon]

tant qu'a faire on va au plus simple

Sub LireFeuillesXLSX_JS()
    Dim xlsxPath As String, tempFolder As String, xmlPath As String
    Dim fso As Object, wb As Object, html As String, xmlContent As String
    Dim cmd As String, objShell As Object, execObj As Object
    Dim resultat As Variant
    ' Chemin de ton fichier Excel fermé
    'xlsxPath = "C:Excel\Test Case #4.xlsx"
    xlsxPath = "C:\Users\patricktoulon\Desktop\Classeur1.xlsx"
    ' Dossier temporaire
    tempFolder = ThisWorkbook.Path
    
    xmlPath = tempFolder & "\xl\workbook.xml"
    ' --- Étape 1 : Extraction de workbook.xml avec tar ---
    cmd = "tar -xf """ & xlsxPath & """ -C " & tempFolder & " xl/workbook.xml"
    Set objShell = CreateObject("WScript.Shell")
    result = objShell.Run(cmd, 0, True)
   X = FreeFile
    Open xmlPath For Binary Access Read As #X
    xmlContent = String(LOF(X), " ")
    Get #X, , xmlContent
    Close #X
  
   t = Split(xmlContent, "<sheet name=""")
   For I = 1 To UBound(t)
   MsgBox Split(t(I), """")(0)
   Next
End Sub

et pour le coup c'est même un peu plus rapide que Ado de quelques nano secondes

 

[nullosse]

Pour le problème de patricktoulon avec le javascript (il me semble qu'il travaille en Excel 2013) l'I.A m'a peut-être fourni une explication :

Ce que vous observez est normal : le moteur htmlfile (MSHTML) n’est pas exactement le même entre Excel 2013 et Excel 2016.

Pourquoi ça coince sous Excel 2013 ?​

• Excel 2013 installe un moteur Internet Explorer basé sur IE9/IE10.
• Excel 2016 s’appuie sur une version plus récente (IE11).
• Certaines API JavaScript/ActiveX ou même le parentWindow ne se comportent pas pareil.
• Résultat : votre appel doc.parentWindow.getSheetNames(...) peut renvoyer une erreur (souvent "Objet requis" ou "Propriété/méthode non gérée").

 

[patricktoulon]

Pour le problème de patricktoulon avec le javascript (il me semble qu'il travaille en Excel 2013) l'I.A m'a peut-être fourni une explication :

Ce que vous observez est normal : le moteur htmlfile (MSHTML) n’est pas exactement le même entre Excel 2013 et Excel 2016.

Pourquoi ça coince sous Excel 2013 ?​

• Excel 2013 installe un moteur Internet Explorer basé sur IE9/IE10.
• Excel 2016 s’appuie sur une version plus récente (IE11).
• Certaines API JavaScript/ActiveX ou même le parentWindow ne se comportent pas pareil.
• Résultat : votre appel doc.parentWindow.getSheetNames(...) peut renvoyer une erreur (souvent "Objet requis" ou "Propriété/méthode non gérée").

faux ;le com IE est ben celui de Window11
j'ai verifier bien entendu
surtout que j'ai empecher la mise ajour de windows qui supprimatit IE de l'environnement et c'est bien la version 11 que j'ai

après je ne sais pas pourquoi tu passe par du html+JS pour parser un xml ????? 😵‍💫 🙃🙃
c'est donc une belle cascade mais inutile a mon gout
je le prouve d'ailleurs avec la lecture en string du xmlcontent tout simplement
et même avec un domdocument (xml) pour parser est amplement suffisant

je retiens néanmoins la ligne du "tar"

Sub test()
    xlsxPath = "C:\Users\patricktoulon\Desktop\Classeur1.xlsx"
    MsgBox Join(ListfeuilleXml(xlsxPath), vbCrLf)
End Sub


Function ListfeuilleXml(xlsxPath)
    Dim tempFolder As String, xmlPath As String
    Dim fso As Object, wb As Object, html As String, xmlContent As String
    Dim cmd As String, objShell As Object, execObj As Object
    Dim resultat As Variant
    ' Chemin de ton fichier Excel fermé
    'xlsxPath = "C:Excel\Test Case #4.xlsx"
    ' Dossier temporaire
    tempFolder = ThisWorkbook.Path
    
    xmlPath = tempFolder & "\xl\workbook.xml"
    ' --- Étape 1 : Extraction de workbook.xml avec tar ---
    cmd = "tar -xf """ & xlsxPath & """ -C " & tempFolder & " xl/workbook.xml"
    Set objShell = CreateObject("WScript.Shell")
    result = objShell.Run(cmd, 0, True)
    
    X = FreeFile
    Open xmlPath For Binary Access Read As #X: xmlContent = String(LOF(X), " "): Get #X, , xmlContent: Close #X
    
    t = Split(xmlContent, "<sheet name=""")
    ReDim tx(1 To UBound(t) + 1)
    For I = 1 To UBound(t)
        tx(I) = Split(t(I), """")(0)
    Next
    ListfeuilleXml = tx
    
    'supprimer le dossier xl avec le xml temporaire en un coup (2 methode)
    'méthode 1
    CreateObject("Scripting.FileSystemObject").GetFolder(tempFolder & "\xl").Delete
    
    'ou
    ' methode2
    'Shell ("cmd /c RD /S /Q " & tempFolder & "\xl")
     
End Function