Process trop long VBA XML

Bonjour,

J’ai un problème au niveau du temps d’acquisition qui est beaucoup trop long (6 min pour un fichier).

J’extrais sous vba des données provenant d’un fichier XML.

Mon process est long car je boucle X fois dans l’intégralité du fichier ! J’aimerais boucler sur un bloc de balise et passer à un autre bloc. Sur l’exemple du fichier donné ci-dessous je voudrais pouvoir boucler dans les balises « balisepere » et pouvoir extraire des valeurs (pas toutes) dans chaque nœud.

J’ai pu voir sur les forums des méthodes pour rentrer dans les balises excel mais je n’arrive pas à l’adapter.

Je vous mets aussi un bout de mon programme pour vous montrer la méthode que j’utilise que j’ai « adapté » pour le fichier xml que je vous ai mis.

For Xn = 0 To X - 1

'obtention des types

genre = oXML.getElementsByTagName("noeud1").Item(Xn).Attributes.getNamedItem("Type").NodeValue

ActiveSheet.Cells(Xn + i, 1) = genre

'si type = C ou S on recupere les données equipement

If genre = "Connector" Or genre = "Shell" Then

equipement = oXML.getElementsByTagName("noeud1").Item(Xn).Attributes.getNamedItem("tag").NodeValue

ActiveSheet.Cells(Xn + i, 3) = equipement

End If

For Yn = 0 To Y - 1

If xml_doc.getElementsByTagName("noeud2").Item(Yn).Attributes.getNamedItem("info").NodeValue = equipement Or xml_doc.getElementsByTagName("noeud2").Item(Yn).Attributes.getNamedItem("info2").NodeValue = equipement Then

pin = xml_doc.getElementsByTagName("noeud2").Item(Yn).Attributes.getNamedItem("info3").NodeValue

ref = xml_doc.getElementsByTagName("noeud2").Item(Yn).Attributes.getNamedItem(“tag").NodeValue

End If

Next Yn

Next Xn

Bonjour Sarah,

En utilisant le XMLDom il me semble que ça peut être rapide.

Voir fichier test joint qui lit et décode le 'exemple.xml' si il est dans le même dossier :

Sub test()
Dim Xml As Object, elem As Object, LM As Object, Lg As Object
Dim T() As Variant, idx As Long

    Set Xml = CreateObject("Microsoft.XMLDOM")
    Xml.Load ActiveWorkbook.Path & "\exemple.xml"
    idx = 0
    ReDim T(3, idx)
    T(0, 0) = "tag"
    T(1, 0) = "type"
    T(2, 0) = "info"
    T(3, 0) = "info2"

    Set elem = Xml.getElementsByTagName("balisepere")
    For Each LM In elem
        idx = idx + 1
        ReDim Preserve T(3, idx)

        Set Lg = LM.getElementsByTagName("noeud1")
        T(0, idx) = Lg(0).Attributes(0).NodeValue
        T(1, idx) = Lg(0).Attributes(1).NodeValue

        Set Lg = LM.getElementsByTagName("noeud2")
        T(2, idx) = Lg(0).Attributes(0).NodeValue
        T(3, idx) = Lg(0).Attributes(1).NodeValue 
    Next

    Set Lg = Nothing
    Set elem = Nothing
    Set Xml = Nothing
    Sheets("Feuil1").Range("A1").Resize(UBound(T, 2) + 1, UBound(T, 1) + 1) = Application.Transpose(T)
End Sub

Pierre

merci pour votre réponse ca je vais tester ca !!