[VBA] fusion de 2 fichier XML ?

Résolu
mortelrdv -  
 mortelrdv -
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:

1 réponse

Réponse 1 / 1
mortelrdv
 
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
0