Création - Modification de fichiers xml par la Library MSXML2

**pijaku** · 13/09/2017, 09h58

Bonjour,

Les procédures décrites dans cette contributions nécessitent de cocher la référence : Microsoft XML, vX.X.
Pour cela, sous VBE : Outils/Références chercher puis cocher...

Comment créer un nouveau document XML ?
1- en Liaison Tardive (non recommandée) :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Option Explicit
 
Public Sub CreationXml()
Dim MyXml As Object
 
    Set MyXml = CreateObject("MSXML2.DOMDocument")
    '*** ici du code
    Set MyXml = Nothing
End Sub

2- En Liaison anticipée (recommandée) :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Option Explicit
 
Public Sub CreationXmlEarly()
Dim MyXml As MSXML2.DOMDocument
 
    Set MyXml = New MSXML2.DOMDocument
    '*** ici du code
    Set MyXml = Nothing
End Sub

ou (cf l'aide VBA (Dim, instruction) à propos du mot clé New) :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
Option Explicit
 
Public Sub CreationXmlEarly()
Dim MyXml As New MSXML2.DOMDocument
 
    With MyXml
    '*** ici du code
    End With
    Set MyXml = Nothing
End Sub

Comment charger un document XML existant ?
Si vous n'avez pas de fichier xml sous la main : Lien MSDN

Function load(xmlSource) As Boolean
Membre de MSXML2.DOMDocument
Charge un document à partir de la source xml spécifiée.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
Option Explicit
 
Public Sub LoadFile()
Dim MyXml As New MSXML2.DOMDocument
 
    With MyXml
        .Load "C:\Users\pijaku\Desktop\Fichier.xml"
        Debug.Print .XML
    End With
    Set MyXml = Nothing
End Sub

Comment charger un document XML à partir d'une variable String?
Note : pour xlRangeValueXMLSpreadsheet, lire : Lien msdn

Function loadXML(bstrXML As String) As Boolean
Membre de MSXML2.DOMDocument
charge le document à partir d'un String

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
Option Explicit
 
Public Sub LoadStringInXml()
Dim MyXml As New MSXML2.DOMDocument
Dim MyString As String
 
    MyString = Range("A1").Value(xlRangeValueXMLSpreadsheet)
    With MyXml
        .LoadXML (MyString)
        Debug.Print .XML
    End With
    Set MyXml = Nothing
End Sub

Comment accéder à un Noeud ?

Function selectSingleNode(queryString As String) As IXMLDOMNode
Membre de MSXML2.DOMDocument
execute query on the subtree

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Option Explicit
 
Public Sub AccessNode()
Dim MyXml As New MSXML2.DOMDocument
Dim Noeud As IXMLDOMNode
Dim MyString As String
 
    MyString = Range("A1").Value(xlRangeValueXMLSpreadsheet)
    With MyXml
        .LoadXML (MyString)
        'accès au Noeud :
            '<Workbook>
                '<Styles>
                    '<Style>
        Set Noeud = .SelectSingleNode("/Workbook/Styles/Style")
        MsgBox Noeud.ParentNode.BaseName
    End With
    Set Noeud = Nothing
    Set MyXml = Nothing
End Sub

Note : Si plusieurs occurrences du Nœud cherché dans le document xml, ne renvoie que le premier trouvé.

Comment Lister des Noeuds d'un document xml en fonction de leur nom ?
Ici nous allons recharger le fichier xml trouvé chez Microsoft.

Function getElementsByTagName(tagName As String) As IXMLDOMNodeList
Membre de MSXML2.DOMDocument
Construit une liste des éléments par le nom

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Option Explicit
 
Public Sub ListNodes()
Dim MyXml As New MSXML2.DOMDocument
Dim Noeuds As MSXML2.IXMLDOMNodeList
Dim Noeud As IXMLDOMNode
 
    With MyXml
        .Load "C:\Users\pijaku\Desktop\Fichier.xml"
        Set Noeuds = .getElementsByTagName("book")
        For Each Noeud In Noeuds
            Debug.Print Noeud.FirstChild.BaseName & " :==> " & Noeud.FirstChild.Text
        Next
    End With
    Set Noeuds = Nothing
    Set MyXml = Nothing
End Sub

Autre méthode :

Function selectNodes(queryString As String) As IXMLDOMNodeList
Membre de MSXML2.IXMLDOMNode
exécute la recherche dans la structure

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Option Explicit
 
Public Sub ListNodes2()
Dim MyXml As New MSXML2.DOMDocument
Dim Noeuds As MSXML2.IXMLDOMNodeList
Dim Noeud As IXMLDOMNode
 
    With MyXml
        .Load "C:\Users\pijaku\Desktop\Fichier.xml"
        Set Noeud = .SelectSingleNode("/catalog")
        Set Noeuds = Noeud.SelectNodes("book")
        For Each Noeud In Noeuds
            Debug.Print Noeud.FirstChild.BaseName & " :==> " & Noeud.FirstChild.Text
        Next
    End With
    Set Noeud = Nothing
    Set Noeuds = Nothing
    Set MyXml = Nothing
End Sub

Comment ajouter une balise à notre document ?

Function createElement(tagName As String) As IXMLDOMElement
Membre de MSXML2.DOMDocument
Créé un élément "node"

Function appendChild(newChild As IXMLDOMNode) As IXMLDOMNode
Membre de MSXML2.DOMDocument
Ajoute un "node" "enfant"

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Option Explicit
 
Public Sub AddBalise()
Dim MyXml As New MSXML2.DOMDocument
Dim Element As IXMLDOMElement
 
    With MyXml
        .LoadXML (Range("A1").Value(xlRangeValueXMLSpreadsheet))
        Set Element = .createElement("MyElem")
        .DocumentElement.appendChild Element
    End With
    Set Element = Nothing
    Set MyXml = Nothing
End Sub

Comment ajouter une balise à un emplacement défini ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Option Explicit
 
Public Sub AddElementToBalise()
Dim MyXml As New MSXML2.DOMDocument
Dim Balise As IXMLDOMElement
Dim Element As IXMLDOMElement
 
    With MyXml
        .LoadXML (Range("A1").Value(xlRangeValueXMLSpreadsheet))
        Set Balise = .SelectSingleNode("/Workbook/Styles/Style")
        Set Element = .createElement("MyElem")
        Balise.appendChild Element 'positionnement
    End With
    Set Balise = Nothing
    Set Element = Nothing
    Set MyXml = Nothing
End Sub

Comment ajouter une balise à une balise et une valeur à cette balise ?

Property text As String

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Option Explicit
 
Public Sub AddNode()
Dim MyXml As New MSXML2.DOMDocument
Dim Element As IXMLDOMElement
Dim Noeud As IXMLDOMNode
 
    With MyXml
        .LoadXML (Range("A1").Value(xlRangeValueXMLSpreadsheet))
        Set Element = .createElement("element")
        .DocumentElement.appendChild Element
        Set Noeud = .createElement("COLUMNS")
        Noeud.Text = "Colonne"
        Element.appendChild Noeud
    End With
    Set Element = Nothing
    Set Noeud = Nothing
    Set MyXml = Nothing
End Sub

Autre méthode :

Function insertBefore(newChild As IXMLDOMNode, refChild) As IXMLDOMNode
Membre de MSXML2.IXMLDOMNode
insère un nœud enfant

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Option Explicit
 
Public Sub AddNode2()
Dim MyXml As New MSXML2.DOMDocument
Dim NewNoeud As IXMLDOMNode
Dim NoeudCible As IXMLDOMNode
Dim Noeud As IXMLDOMNode
 
    With MyXml
        .LoadXML (Range("A1").Value(xlRangeValueXMLSpreadsheet))
        Set NoeudCible = .SelectSingleNode("/Workbook/Styles/Style")
        Set NewNoeud = .createElement("COLUMNS")
        NewNoeud.Text = "Colonne"
        If Not NoeudCible Is Nothing Then
            Set Noeud = NoeudCible.insertBefore(NewNoeud, Noeud)
        End If
    End With
    Set NoeudCible = Nothing
    Set NewNoeud = Nothing
    Set Noeud = Nothing
    Set MyXml = Nothing
End Sub

Comment supprimer un Noeud ?

Function removeChild(childNode As IXMLDOMNode) As IXMLDOMNode
Membre de MSXML2.IXMLDOMNode
Supprime un Noeud enfant

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Public Sub DeleteNode()
Dim MyXml As New MSXML2.DOMDocument
Dim Noeud As IXMLDOMNode
Dim MyString As String
 
    MyString = Range("A1").Value(xlRangeValueXMLSpreadsheet)
    With MyXml
        .LoadXML (MyString)
        Set Noeud = .SelectSingleNode("/Workbook/Styles/Style")
        Noeud.ParentNode.RemoveChild Noeud
    End With
    Set Noeud = Nothing
    Set MyXml = Nothing
End Sub

Comment accéder aux attributs d'une balise ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Option Explicit
 
Public Sub AccessAttributes()
Dim docxml As New MSXML2.DOMDocument    'Nouveau doc Xml
Dim Noeud As IXMLDOMNode                'Node
Dim Attributs As IXMLDOMNamedNodeMap    'Collection
Dim A As IXMLDOMAttribute               'Pour boucler sur la collection
 
    With docxml
        .LoadXML (Range("A1").Value(xlRangeValueXMLSpreadsheet))
        Set Noeud = .SelectSingleNode("/Workbook/Styles/Style")
        If Not Noeud Is Nothing Then
            Set Attributs = Noeud.Attributes
            For Each A In Attributs
                Debug.Print A.BaseName & " := " & A.Value
            Next
        End If
    End With
End Sub

Comment lister les attributs d'une balise en fonction du nom de la balise et de celui de l'attribut ?

Function getAttribute(name As String)
Membre de MSXML2.IXMLDOMElement
Cherche la valeur d'un attribut par le nom

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
Option Explicit
 
Public Sub ListAttributes()
Dim docxml As New MSXML2.DOMDocument    'Nouveau doc Xml
Dim Noeuds As IXMLDOMNodeList           'Liste de noeuds de docxml
Dim E As IXMLDOMElement                 'Elément
Dim vIn As String                       'A chercher
Dim vOut As String                      'Valeur de retour
 
    With docxml
        .LoadXML (Range("A1").Value(xlRangeValueXMLSpreadsheet))
        .async = False 'attente du chargement
        'recherche toutes les balises nommées : "Font"
        Set Noeuds = .getElementsByTagName("Font")
        'Nom de l'attribut à chercher
        vIn = "ss:FontName"
        If Not Noeuds Is Nothing Then
            'boucle sur les balises "Font"
            For Each E In Noeuds
                'retourne la valeur des attributs nommés : "ss:FontName"
                vOut = E.getAttribute(vIn)
                Debug.Print vOut
            Next
        End If
    End With
    Set docxml = Nothing
    Set Noeuds = Nothing
End Sub

Comment ajouter un attribut à une balise ?

Sub setAttribute(name As String, value)
Membre de MSXML2.IXMLDOMElement
Créée un attribut et lui donne un nom et une valeur

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Option Explicit
 
Public Sub AddAttribute()
Dim MyXml As New MSXML2.DOMDocument
Dim Balise As IXMLDOMElement
Dim Element As IXMLDOMElement
 
    With MyXml
        .LoadXML (Range("A1").Value(xlRangeValueXMLSpreadsheet))
        Set Balise = .SelectSingleNode("/Workbook/Styles/Style")
        Set Element = .createElement("element")
        Element.Text = "Ma Valeur"
        Element.setAttribute "ID", "123"
        Balise.appendChild Element
    End With
    Set Balise = Nothing
    Set Element = Nothing
    Set MyXml = Nothing
End Sub

Comment supprimer un attribut ?

Sub removeAttribute(name As String)
Membre de MSXML2.IXMLDOMElement
Supprime un attribut par le nom

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Option Explicit
 
Public Sub DeleteAttribut()
Dim MyXml As New MSXML2.DOMDocument
Dim Noeud As IXMLDOMElement
 
    With MyXml
        .LoadXML (Range("A1").Value(xlRangeValueXMLSpreadsheet))
        Set Noeud = .SelectSingleNode("/Workbook/Styles/Style")
        Noeud.removeAttribute "ss:ID"
    End With
    Set Noeud = Nothing
    Set MyXml = Nothing
End Sub

Comment enregistrer un fichier xml ?

Sub save(destination)
Membre de MSXML2.DOMDocument
Enregistre le document à l'emplacement spécifié

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
Option Explicit
 
Public Sub SaveXml()
Dim MyXml As New MSXML2.DOMDocument
Dim Balise As IXMLDOMElement
Dim Element As IXMLDOMElement
 
    With MyXml
	'chargement
        .Load "C:\Users\pijaku\Desktop\Fichier.xml"
	'modifications
        Set Balise = .SelectSingleNode("/catalog/book")
        Set Element = .createElement("element")
        Element.Text = "Ma Valeur"
        Element.setAttribute "ID", "123"
        Balise.appendChild Element
	'Enregistrer
        .Save "C:\Users\pijaku\Desktop\Fichier.xml"
	'enregistrer sous (suffit de changer le nom)
        '.Save "C:\Users\pijaku\Desktop\Fichier2.xml"
    End With
    Set Balise = Nothing
    Set Element = Nothing
    Set MyXml = Nothing
End Sub

Voilà.
Si vous voyez d'autres choses, fonctions à ajouter, n'hésitez pas.

EDIT : Ajout de la méthode selectNodes
EDIT2 : Ajout de la méthode insertBefore

**kiki29** · 13/09/2017, 13h23

Salut, à consulter également : VBA et développement Web

Création - Modification de fichiers xml par la Library MSXML2

Contribuez

Discussions similaires

Partager

Partager