[VBA] fusion de 2 fichier XML ?

Résolu/Fermé

mortelrdv - 19 oct. 2010 à 19:19
mortelrdv - 21 oct. 2010 à 21:30

Bonjour,

j'utilise Excel 2003 SP2 sous winXP, et dans le VBA j'utilise la référence "Microsoft XML 3.0"

je cherche à fusionner 2 fichiers XML. Prenons par exemple ces 2 fichiers ci-dessous :
essai1.xml

<?xml version="1.0" encoding="ISO-8859-1"?>
<personnes>
    <personne age="49">
        <prenom>Georges</prenom>
        <etat>Marié</etat>
        <enfants>
            <enfant>
                <nom>Tiop</nom>
            </enfant>
        </enfants>
    </personne>
    <personne age="88">
        <nom>Godoh</nom>
        <prenom>Madeleine</prenom>
        <etat>Veuve</etat>
        <enfants>
            <enfant id="top">
                <nom>Godoh</nom>
                <prenom>Jean-Marie</prenom>
            </enfant>
            <enfant id="titi">
                <prenom>Etienne</prenom>
            </enfant>
        </enfants>
    </personne>
</personnes>

essai2.xml

<?xml version="1.0" encoding="ISO-8859-1"?>
<personnes>
    <personne age="49">
        <nom>Baud</nom>
        <etat>Marié</etat>
        <enfants>
            <enfant>
                <prenom>Elisabeth</prenom>
            </enfant>
        </enfants>
    </personne>
    <personne age="88">
        <nom>Godoh</nom>
        <prenom>Madeleine</prenom>
        <etat>Veuve</etat>
        <enfants>
            <enfant id="top">
                <nom>Godoh</nom>
            </enfant>
            <enfant id="titi">
                <nom>Godoh</nom>
                <prenom>Etienne</prenom>
            </enfant>
        </enfants>
    </personne>
</personnes>

Le résultat serait, si on prend essai1.xml comme référence

<?xml version="1.0" encoding="ISO-8859-1"?>
<personnes>
    <personne age="49">
        <nom>Baud</nom>
        <prenom>Georges</prenom>
        <etat>Marié</etat>
        <enfants>
            <enfant>
                <nom>Tiop</nom>
                <prenom>Elisabeth</prenom>
            </enfant>
        </enfants>
    </personne>
    <personne age="88">
        <nom>Godoh</nom>
        <prenom>Madeleine</prenom>
        <etat>Veuve</etat>
        <enfants>
            <enfant id="top">
                <nom>Godoh</nom>
                <prenom>Jean-Marie</prenom>
            </enfant>
            <enfant id="titi">
                <nom>Godoh</nom>
                <prenom>Etienne</prenom>
            </enfant>
        </enfants>
    </personne>

image avec couleur c'est peut etre plus parlant
https://www.casimages.com/i/101019071102115823.jpg.html
http://www.zimage.biz/photo.php?id=63966

Merci de vos aides
PS: en vrai, vous vous endoutez que essai1.xml et essai2.xml est plus grand avec plus de nodes et de sous-nodes et de sous-sous-nodes et de sou.....

A voir également:

[VBA] fusion de 2 fichier XML ?
Fichier rar - Guide
Fichier host - Guide
Fichier iso - Guide
Comment réduire la taille d'un fichier - Guide
Xml viewer - Télécharger - Édition & Programmation

1 réponse

Réponse 1 / 1

mortelrdv
21 oct. 2010 à 21:30

Bon j'ai réussi à faire ce que je voulais, pour mon cas. C'est surement pas très optimal, mais bon je le mets.

Function test()
    Dim xmlDocA As New DOMDocument60
    Dim xmlDocB As New DOMDocument60
    
    xmlDocA.async = False
    xmlDocA.Load "c:\xmlbooks1.xml"
    
    xmlDocB.async = False
    xmlDocB.Load "c:\xmlbooks2.xml"
    
    recursif xmlDocA.DocumentElement, xmlDocB.DocumentElement, 1
   
    xmlDocA.Save "c:\result.xml"
    Set xmlDocA = Nothing
    Set xmlDocB = Nothing
End Function

Function recursif(ByRef parentElementA As IXMLDOMElement, ByRef parentElementB As IXMLDOMElement, ByVal Level As Integer)
    Dim indexaA As Integer
    Dim indexaB As Integer
    
    For IndexA = 0 To parentElementA.ChildNodes.Length - 1
        IndexB = 0
        Do While IndexB <= (parentElementB.ChildNodes.Length - 1)
            If parentElementA.ChildNodes(IndexA).NodeType = NODE_TEXT Or _
               parentElementB.ChildNodes(IndexB).NodeType = NODE_TEXT Then Exit Function
            
            If extractNodeAttributes(parentElementA.ChildNodes(IndexA).XML) = _
               extractNodeAttributes(parentElementB.ChildNodes(IndexB).XML) Then
                recursif parentElementA.ChildNodes(IndexA), parentElementB.ChildNodes(IndexB), Level + 1
                parentElementB.RemoveChild parentElementB.ChildNodes(IndexB)
                'IndexB = 0
            Else
                IndexB = IndexB + 1
            End If
        Loop
    Next IndexA
    
    For IndexA = 0 To parentElementB.ChildNodes.Length - 1
        parentElementA.appendChild parentElementB.ChildNodes(IndexA)
    Next IndexA
End Function

Function extractNodeAttributes(ByVal xmlString As String) As String
    Dim iEnd As Integer
    
    iEnd = InStr(1, xmlString, ">", vbTextCompare)
    extractNodeAttributes = Mid(xmlString, 2, iEnd - 2)
End Function

Discussions similaires

comment donner les droits sur fichier partage

Chemin Logo du site de la Cité de l'espace

ouverture d'un fichier excel à partir d'un code VBA

Discussions similaires

Newsletters