[VBA] fusion de 2 fichier XML ? Résolu

Question

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 Georges Marié Tiop Godoh Madeleine Veuve Godoh Jean-Marie Etienne essai2.xml Baud Marié Elisabeth Godoh Madeleine Veuve Godoh Godoh Etienne Le résultat serait, si on prend essai1.xml comme référence Baud Georges Marié Tiop Elisabeth Godoh Madeleine Veuve Godoh Jean-Marie Godoh Etienne 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..... Configuration: Windows 7 / Firefox 3.6.10

mortelrdv · Answer

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

[VBA] fusion de 2 fichier XML ?

1 réponse

Discussions similaires

Newsletters