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.

 

[Dudu2]

@laurent950,
Étrange ! Quelque soit le fichier que je lui donne, il retourne:

@dysorthographie,
Dans ton Post #150,

Function ADONameToExcel(adoName As String) As String
    .../...
    ' Remplacements spécifiques faits par ADO
    nom = Replace(nom, "#", ".") ' le point devient #
    nom = Replace(nom, "_", "!") ' le point d’exclamation devient

Pareil, tu ne peux pas savoir si le "#" et le "_" sont de vrais "#" et "_" (qui ne posent pas de problème) ou le remplacement d'un "." et d'un "!". Mieux vaut garder les vrais caractères "#" et "_" (plus probables) et ne pas convertir les faux.

 

[nullosse]

Ok. Mais je pige pas tout car en principe il n'y a aucune possibilité de communication entre 2 instances Excel.
Et là il semble que le classeur ouvert en instance #2 soit complètement accessible en instance #1. Etonnant !

communication possible en VBA par objet COM ( Excel.Application)
ordre d'idée en temps (chez moi):
CreateObject("Excel.Application") 500 ms (on peut laisser l'instance ouverte si on a plusieurs fichiers à traiter).
Ouverture d'un classeur : 120 ms.
Quelques traitements comme lire le nom des feuilles et lire une petite plage de données : 30 ms.
Il faut se méfier aussi de ne pas avoir d'erreur avant la destruction de l'instance sinon on risque de se retrouver avec une instance fantome en mémoire ( visible dans les processus d'arrière-plan du gestionnaire des tâches)

 

[Dudu2]

@nullosse,
Je ferai ça si vraiment y a rien d'autre à faire.

Ça ne fonctionne pas à cause de la requête SQL qui considère ces "!" et "." comme des caractères de séparation et qui ne donne aucune possibilité d'escape caractère !

Pour récupérer les données d'un classeur fermé, Internet propose des méthodes différentes, mais à chaque fois il faut préciser un Range ou une cellule. Je veux récupérer le UsedRange de la feuille que je ne connais évidemment pas et le SQL est jusque là ma seule option.

Dans un de ses messages @dysorthographie parle listetable, mais je n'en sais pas plus. T'as une idée de ce que c'est ?

 

[dysorthographie]

@laurent950,
Étrange ! Quelque soit le fichier que je lui donne, il retourne:

Regarde la pièce jointe 1222264

@dysorthographie,
Dans ton Post #150,

Function ADONameToExcel(adoName As String) As String
    .../...
    ' Remplacements spécifiques faits par ADO
    nom = Replace(nom, "#", ".") ' le point devient #
    nom = Replace(nom, "_", "!") ' le point d’exclamation devient

Pareil, tu ne peux pas savoir si le "#" et le "_" sont de vrais "#" et "_" (qui ne posent pas de problème) ou le remplacement d'un "." et d'un "!". Mieux vaut garder les vrais caractères "#" et "_" (plus probables) et ne pas convertir les faux.

Pour moi ce n'est pas grave. Si tu cherche un onglet c'est que tu connais son nom. Donc tu convertis son nom au format ado et tu utilises la méthode tablexist

 

[nullosse]

Dans un de ses messages @dysorthographie parle listetable, mais je n'en sais pas plus. T'as une idée de ce que c'est ?

non je ne sais pas ce que c'est.
Tu as beaucoup de classeurs à ouvrir et le usedRange c'est que celui d'une feuille ? tu en fais quoi du usedrange ? traitement en vba ?
Il y a des contraintes de temps ?
Le Powerquery peut lire le nom des feuilles d'un classeur mais aussi les data mais le résultat est utilisable en feuille

 

[Dudu2]

Le PowerQuery, bof car il faut ajouter la requête à la feuille et là on est dans des classeurs fermés.
Le UsedRange récupéré, je l'utilise en VBA pour analyser le contenu et chercher des Tags pour extraire certaines parties.

Bon, je vais essayer de coder l'ouverture en instance cachée, et la création d'un classeur temporaire avec la ou les feuilles au nom problématique copiées et renommées pour en extraire le contenu par SQL.

 

[nullosse]

Le UsedRange récupéré, je l'utilise en VBA pour analyser le contenu et chercher des Tags pour extraire certaines parties.
Bon, je vais essayer de coder l'ouverture en instance cachée, et la création d'un classeur temporaire avec la ou les feuilles au nom problématique copiées et renommées pour en extraire le contenu par SQL.

et pourquoi par SQL ? elle est compliquée la requête ?
On peut chercher directement les tags dans le classeur ouvert dans l'instance cachée ou récupérer le usedrange dans le VBA

 

[dysorthographie]

Dans un de ses messages @dysorthographie parle listetable, mais je n'en sais pas plus. T'as une idée de ce que c'est ?

Poste #3

 

[laurent950]

@laurent950,
Étrange ! Quelque soit le fichier que je lui donne, il retourne:

' https://analystcave.com/vba-xml-working-xml-files/
Sub ListSheetNames()
' Chemin :
    Dim origPath As String
    Dim origFich As String
    Dim zipPath As String
' Créer une instance de Shell.Application
    Dim shellApp As Object
' Ouvrir le fichier .zip comme un fichier ZIP
    Dim zip As Object
' Parcourir les éléments pour trouver le dossier "xl"
    Dim item As Object
' Parcourir les éléments dans "xl" pour trouver workbook.xml
    Dim subItem As Object
' Extraire workbook.xml dans TEMP
    Dim xmlFile As String
' Charger le document XML
    Dim XDoc As Object
    Dim xmlContent As Object
' Collecte des nom des Feuilles
    Dim sheetNames As Collection
    Dim sheetName As Variant
    Dim startPos As Long, endPos As Long
    Dim cheminFich As String
' -----------------------------------------------------------------------------

    ' Chemin du fichier XLSX
    origPath = "C:\Users\VotreChemin\LeDossier\"
    origFich = "LeFichier.xlsx"
    zipPath = origPath & origFich & ".zip"

    ' Renommer temporairement en .zip
    Name origPath & origFich As zipPath

    ' Créer une instance de Shell.Application
    Set shellApp = CreateObject("Shell.Application")

    ' Ouvrir le fichier .zip comme un fichier ZIP
    Set zip = shellApp.Namespace(CStr(zipPath))

    ' Vérifier si le fichier ZIP a été ouvert correctement
    If Not zip Is Nothing Then
        ' Parcourir les éléments pour trouver le dossier "xl"
        For Each item In zip.Items
            If item.Name = "xl" Then
                ' Parcourir les éléments dans "xl" pour trouver workbook.xml
                For Each subItem In item.GetFolder.Items
                    If InStr(subItem.Name, "workbook.xml") > 0 Then
                        ' Extraire workbook.xml dans TEMP
                            'xmlFile = Environ("TEMP") & "\workbook.xml"
                            'xmlFile = origPath & CStr(subItem.Name)
                            xmlFile = Environ("TEMP") & "\" & CStr(subItem.Name)
                            ' Copie effective depuis le ZIP vers TEMP
                            shellApp.Namespace(Environ("TEMP")).CopyHere subItem
                            ' CopyHere fait l’extraction asynchrone, donc il faut attendre que le fichier apparaisse dans TEMP avant de le lire :
                            Do While Dir(xmlFile) = ""
                                DoEvents
                            Loop
                        ' Lire le contenu XML
                            Set XDoc = CreateObject("MSXML2.DOMDocument")
                                XDoc.async = False: XDoc.validateOnParse = False
                                'XDoc.Load (ThisWorkbook.Path & "\workbook.xml")
                                'XDoc.Load (origPath & CStr(subItem.Name))
                                XDoc.Load (xmlFile)
                        'Get Document Elements
                            Set xmlContent = XDoc.DocumentElement
                                'MsgBox xmlContent.XML
                        Exit For
                    End If
                Next subItem
                Exit For
            End If
        Next item
    End If

    ' Extraire les noms des feuilles
    Set sheetNames = New Collection
    If Len(xmlContent.XML) > 0 Then
        startPos = InStr(1, xmlContent.XML, "<sheet name=""")
        Do While startPos > 0
            startPos = startPos + Len("<sheet name=""")
            endPos = InStr(startPos, xmlContent.XML, """")
            sheetName = Mid(xmlContent.XML, startPos, endPos - startPos)
            sheetNames.Add sheetName
            startPos = InStr(endPos, xmlContent.XML, "<sheet name=""")
        Loop
    End If

    ' Afficher les noms des feuilles
    For Each sheetName In sheetNames
        Debug.Print sheetName
        Affichage = Affichage & (i + 1) & " - " & sheetName & vbCrLf
    Next sheetName

    ' Remettre le fichier à son nom d'origine
    Name zipPath As origPath & origFich
    
    ' Resultat
    MsgBox Affichage
    
    Set XDoc = Nothing ' Libère le XML
    If Dir(xmlFile) <> "" Then Kill xmlFile
    
End Sub

 

[laurent950]

@Dudu2

il faut explorer cette piste ! CreateObject("MSXML2.DOMDocument")
Je la propose comme elle n'avait pas encore etait exploité dans cette ressource

If InStr(subItem.Name, "workbook.xml") > 0 Then
        ' Extraire workbook.xml dans TEMP
            xmlFile = Environ("TEMP") & "\" & CStr(subItem.Name)
            ' Copie effective depuis le ZIP vers TEMP
                shellApp.Namespace(Environ("TEMP")).CopyHere subItem
            ' CopyHere fait l’extraction asynchrone, donc il faut attendre que le fichier apparaisse dans TEMP avant de le lire :
                Do While Dir(xmlFile) = ""
                    DoEvents
                Loop
            ' Lire le contenu XML
                Set XDoc = CreateObject("MSXML2.DOMDocument")
                    XDoc.async = False: XDoc.validateOnParse = False
                    XDoc.Load (xmlFile)
            'Get Document Elements
                Set xmlContent = XDoc.DocumentElement
                'MsgBox xmlContent.XML
    Exit For
    End If

 

[patricktoulon]

re
pourquoi tu tourne en rond laurent?

originalXLX="chemin du fichier xls*"

fichierZIP=lememe avec l'extension ".zip"

xmlFile = Environ("TEMP") & "\workbook.xml"

filecopy originalXLX , fichierZIP

Set shellApp = CreateObject("Shell.Application")

set f=shellApp.Namespace(fichierZIP &"\xl").items.item("workbook.xlm")

shellApp.Namespace(Environ("TEMP")&"\").copyhere f.path

'ton xml est dans le environ(temp)

 

[laurent950]

' https://analystcave.com/vba-xml-working-xml-files/
Sub ListSheetNames_MiseAJoursObtimisé()
' Chemin :
    Dim origPath As String
    Dim origFich As String
    Dim zipPath As String
' Créer une instance de Shell.Application
    Dim shellApp As Object
' Ouvrir le fichier .zip comme un fichier ZIP
    Dim zip As Object
' Parcourir les éléments pour trouver le dossier "xl"
    Dim item As Object
' Parcourir les éléments dans "xl" pour trouver workbook.xml
    Dim subItem As Object
' Extraire workbook.xml dans TEMP
    Dim xmlFile As String
' Charger le document XML
    Dim XDoc As Object
    Dim xmlContent As Object
' Collecte des nom des Feuilles
    Dim sheetNames As Collection
    Dim sheetName As Variant
    Dim startPos As Long, endPos As Long
    Dim cheminFich As String
' -------------------------------------------------------------------
' Extraire les noms des feuilles
    Dim node As Object
' Optimisé : utiliser tableau + Join pour vitesse si beaucoup de feuilles
    Dim arr() As String
    Dim Affichage As String
    Dim i As Long
' Initialisation des variables
    Affichage = ""
    i = 0
' -------------------------------------------------------------------

' Chemin du fichier XLSX
   origPath = "C:\Users\LeChemin\LeDossier\"
   origFich = "LeFichier.xlsx"
   zipPath = origPath & origFich & ".zip"

' Renommer temporairement en .zip
   Name origPath & origFich As zipPath

' Créer une instance de Shell.Application
   Set shellApp = CreateObject("Shell.Application")

' Ouvrir le fichier .zip comme un fichier ZIP
   Set zip = shellApp.Namespace(CStr(zipPath))

If Not zip Is Nothing Then
    ' Parcourir les éléments pour trouver le dossier "xl"
    For Each item In zip.Items
        If item.Name = "xl" Then
            ' Parcourir les éléments dans "xl" pour trouver workbook.xml
            For Each subItem In item.GetFolder.Items
                If InStr(subItem.Name, "workbook.xml") > 0 Then
                    ' Extraire workbook.xml dans TEMP
                        xmlFile = Environ("TEMP") & "\" & CStr(subItem.Name)
                        shellApp.Namespace(Environ("TEMP")).CopyHere subItem
                        Do While Dir(xmlFile) = "": DoEvents: Loop
                    ' Lire le contenu XML
                        Set XDoc = CreateObject("MSXML2.DOMDocument")
                            XDoc.async = False
                            XDoc.validateOnParse = False
                            XDoc.Load xmlFile  ' ? Optimisé : chemin correct
                        Set xmlContent = XDoc.DocumentElement
                    Exit For
                End If
            Next subItem
            Exit For
        End If
    Next item
End If

' -------------------------------------------------------------------
' Extraire les noms des feuilles
    Set sheetNames = New Collection
    If Len(xmlContent.XML) > 0 Then
    ' ? Optimisé : Parsing DOM plus rapide et sûr
        For Each node In xmlContent.getElementsByTagName("sheet")
            sheetNames.Add node.getAttribute("name")
        Next node
    End If

' -------------------------------------------------------------------
' Afficher les noms des feuilles
' ? Optimisé : utiliser tableau + Join pour vitesse si beaucoup de feuilles
    ReDim arr(1 To sheetNames.Count)
    i = 1
    For Each sheetName In sheetNames
        arr(i) = sheetName
        i = i + 1
    Next sheetName
    Affichage = Join(arr, vbCrLf)
    Debug.Print Affichage

' Remettre le fichier à son nom d'origine
    Name zipPath As origPath & origFich

' Résultat
    MsgBox Affichage

' Libération et suppression TEMP
    Set XDoc = Nothing
    If Dir(xmlFile) <> "" Then Kill xmlFile
End Sub

 

[laurent950]

pourquoi tu tourne en rond laurent?

L'idée = Extraire le fichier workbook.xml du fichier xslx/xlsm, soit l'extraire, le copier, et lire les valeurs = ici les feuilles
j'ai essayé avec cela :
' Lire le contenu XML
Set XDoc = CreateObject("MSXML2.DOMDocument")

 

[laurent950]

Variante :

Sub ListSheetNames_MiseAJourSimplifié()
    ' -------------------------------------------------------------------
    ' Objectif : lister les noms des feuilles d'un fichier XLSX
    ' Méthode : copier le fichier en .zip temporaire, extraire workbook.xml
    ' -------------------------------------------------------------------

    Dim origPath As String, origFich As String
    Dim originalXLSX As String, fichierZIP As String
    Dim xmlFile As String
    Dim shellApp As Object, f As Object
    Dim XDoc As Object, xmlContent As Object
    Dim sheetNames As Collection, node As Object
    Dim arr() As String, Affichage As String
    Dim i As Long
    Dim sheetName As Variant

    ' -------------------------------------------------------------------
    ' Chemin du fichier XLSX
    origPath = "C:\Users\VotreChemin\LeDossier\"
    origFich = "LeFichier.xlsx"
    originalXLSX = origPath & origFich
    fichierZIP = Environ("TEMP") & "\tempFile.zip"

    ' Copier le fichier XLSX en ZIP temporaire
    FileCopy originalXLSX, fichierZIP

    ' -------------------------------------------------------------------
    ' Extraire workbook.xml
    xmlFile = Environ("TEMP") & "\workbook.xml"
    Set shellApp = CreateObject("Shell.Application")
    ' Pointer directement sur workbook.xml dans le ZIP
    Set f = shellApp.Namespace(fichierZIP & "\xl").Items.item("workbook.xml")
    shellApp.Namespace(Environ("TEMP") & "\").CopyHere f.Path

    ' Attendre que le fichier soit copié
    Do While Dir(xmlFile) = "": DoEvents: Loop

    ' -------------------------------------------------------------------
    ' Charger le XML
    Set XDoc = CreateObject("MSXML2.DOMDocument")
    XDoc.async = False
    XDoc.validateOnParse = False
    XDoc.Load xmlFile
    Set xmlContent = XDoc.DocumentElement

    ' -------------------------------------------------------------------
    ' Extraire les noms des feuilles
    Set sheetNames = New Collection
    For Each node In xmlContent.getElementsByTagName("sheet")
        sheetNames.Add node.getAttribute("name")
    Next node

    ' -------------------------------------------------------------------
    ' Préparer l'affichage
    ReDim arr(1 To sheetNames.Count)
    i = 1
    For Each sheetName In sheetNames
        arr(i) = sheetName
        i = i + 1
    Next sheetName
    Affichage = Join(arr, vbCrLf)

    ' Afficher le résultat
    Debug.Print Affichage
    MsgBox Affichage

    ' -------------------------------------------------------------------
    ' Nettoyage
    Set XDoc = Nothing
    Set shellApp = Nothing
    If Dir(xmlFile) <> "" Then Kill xmlFile
    If Dir(fichierZIP) <> "" Then Kill fichierZIP

End Sub

 

[patricktoulon]

c'est ma première proposition avec le "MSXML2.DOMDocument"
vous cherchez quoi ?
je crois que l'on a fait le tour non?
shaell.application
wscript.shell ligne de command TAR(toi avec powershell)
Adodb.conn
adodb.catalog
perso moi qui utilise le shell.application pour le ribbonX j'ai adopté le tar avec redirection ver fichier xml
c'est simple hyper rapide
et on se passe des caprice de shell.application