(E03) XML : ou puis-je trouver un tuto/guide pour générer un fichier XML

**Godzestla** · 27/11/2008, 10h17

Bonjour,
Merci pour les pistes que vous pourriez-me proposer.
Je n'y connais rien et c'est d'une urgence maximale.

(je dois convertir toute ma DB access / Excel pour l'exporter en XML).

**Fouinard** · 27/11/2008, 16h43

Salut,

J'ai beaucoup utilisé le XML dans mon dernier projet.

Ensuite il est bien pratique d'apprendre un peu à utiliser XPath car c'est vraiment très pratique !

Bon courage !

**decondelite** · 27/11/2008, 16h47

J'ai pas pris le temps de lire quoi que ce soit, mais à la volée tu auras peut-être quelque chose qui t'intéresse là-dedans:
http://heureuxoli.developpez.com/office/openxml/
http://excel.developpez.com/faq/?page=XML

**Godzestla** · 27/11/2008, 17h08

Merci à tous les 2, je vais potasser cela.

je n'y connais rien et j'espère que c'est applicable au VBA.

Je dois en fait, apparement, peupler un fichier XML préformatté.
Je n'ai aucune idée à quoi cela va ressembler.

Et donc ma source DATA est Excel ou Access, mais bon, c'est pareil, et je pense faire cela à partir de VBA.

Si vous avez de quelconques exemples de code VBA pour cela, je suis preneur histoire de gagner du temps en apprentissage.

Je dois vous laisser? je repasse ce soir.
merci.

**Fouinard** · 28/11/2008, 09h27

voila quelques exemples de codes (les 2 derniers proviennent de projet qui date un peu, je commençais juste l'utilisation de XML avec VBA à l'époque donc il y a sans aucun doute des améliorations à apporter au code.

J'utilise la référence à Microsoft XML v3 car apparement c'est la plus répandue

pour charger un xml :

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
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
	Dim xDoc As MSXML2.DOMDocument30
	Set xDoc = New MSXML2.DOMDocument30
 
	' On lit le fichier d'un seul trait
    xDoc.async = False
 
    ' On tente de charger le document
    If Not xDoc.Load(xmlPath) Then
 
        ' Impossible de charger le document
        Dim strErrText As String
        Dim xPE As MSXML2.IXMLDOMParseError
 
        ' Obtient l'objet ParseError
        Set xPE = xDoc.parseError
 
        ' Recupere les specifications de l'erreur
        With xPE
            strErrText = "Le fichier PJ5 n'a pas pu être chargé " & _
            "pour les raisons suivantes." & vbCrLf & vbCrLf & _
            .reason & vbCrLf & _
            "Ligne : " & .Line & vbCrLf & _
            "Position sur la ligne : " & .linepos & vbCrLf & _
            "Position dans le fichier : " & .filepos & vbCrLf & _
            "Texte source : " & .srcText & vbCrLf & _
            "URL du document : " & .URL
        End With
 
        ' Affiche l'erreur
        MsgBox strErrText, vbExclamation
 
        ' Detruit la varialbe d'erreur
        Set xPE = Nothing
 
        ' stoppe la routine
        Exit Sub
 
    End If
 
    ' ---------------------------------------------------------------
    ' Si on arrive ici c'est que le fichier a été correctement chargé
    ' Maintenant on teste si il s'agit bien d'un pj5
 
    Dim xRoot As IXMLDOMElement
    Dim xElem As IXMLDOMElement
    Dim xAttr As IXMLDOMAttribute
    Set xRoot = xDoc.selectSingleNode("PJ5")
 
    ' Si il n'est pas possible de charger le noeud PJ5 qui est la base
    ' contenant toutes les informations, on l'indique et on stoppe la routine
    If xRoot Is Nothing Then
        MsgBox "Erreur : impossible de trouver le noeud PJ5..."
        Exit Sub
    End If
 
 
	' Exemples de récupération de données, ça marche aussi dans l'autre sens pour les assigner
	' @XXX : XXX est le nom de l'attribut
 
    VersionP3D = xRoot.selectSingleNode("//General/@VersionPJ3D").Text
    NomBaseAntenne = xRoot.selectSingleNode("//General/@NomBase").Text
    NomDeSite = xRoot.selectSingleNode("//General/@NomDeSite").Text
    Localisation = xRoot.selectSingleNode("//General/@Localisation").Text
    CodeIG = xRoot.selectSingleNode("//General/@CodeIG").Text
 
	' Ensuite il est possible de faire passer un noeud XML en argument à une autre classe
	' exemple :
 
    ' Infos du Cable Principal "CablePrincipal"
    CablePrincipal.Init xRoot.selectSingleNode("//CablePrincipal")
 
	'...

et maintenant pour créer des noeud, des attributs, et sauvegarder les modifications :

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
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
    ' -------------------------------------------------
    ' On ajoute le mux à la base
 
    ' Verification de l'existance du répertoire enregistré dans le fichier excel
    Set fs = CreateObject("Scripting.FileSystemObject")
    If Not fs.FolderExists(Worksheets("donnees").Range("L1").Value) Then
        res = MsgBox("Le chemin vers les sauvegardes est introuvable !", vbExclamation + vbOKOnly)
        Load configCheminXML
        configCheminXML.Show (vbModal)
        If Not fs.FolderExists(Worksheets("donnees").Range("L1").Value) Then
            res = MsgBox("Rien n'a été enregistré !", vbExclamation + vbOKOnly)
            Exit Sub
        End If
    End If
 
    Set xmlDoc = New DOMDocument ' objet xml
    xmlDoc.Async = False
 
    xmlDoc.Load xmlSource:=Worksheets("donnees").Range("L1").Value + "\ListeMux.xml" ' charge le ficher
 
    ' --------------------------------------------
    ' Vérification de l'existance du noeud principal
    If Not xmlDoc.hasChildNodes Then
        Set xmlNodeRoot = xmlDoc.createElement("ListeMux") ' création du noeud racine si il n'existe pas deja
        xmlDoc.appendChild xmlNodeRoot ' ajout du noeud racine au document
    End If
 
    ' On récupère le noeud principal
    Set xmlNodeRoot = xmlDoc.selectSingleNode("ListeMux") ' sélection du noeud racine
 
    Set xmlNodeNewEq = xmlDoc.createElement("Mux")
    xmlNodeNewEq.setAttribute "ref", tbRef.Text
    xmlNodeNewEq.setAttribute "nbEntrees", tbNbEntrees.Text
    xmlNodeNewEq.setAttribute "deltaF", tbDeltaF.Text
    xmlNodeNewEq.setAttribute "puissanceBE", tbPuisBE.Text
    xmlNodeNewEq.setAttribute "puissanceLB", tbPuisLB.Text
    xmlNodeNewEq.setAttribute "pertesBE", tbPertBE.Text
    xmlNodeNewEq.setAttribute "pertesLB", tbPertLB.Text
    xmlNodeNewEq.setAttribute "codeArticle", tbCodeArticle.Text
 
    For Each xmlNodeOldEq In xmlNodeRoot.childNodes
        If xmlNodeOldEq.Attributes.getNamedItem("ref").Text = tbRef.Text Or xmlNodeOldEq.Attributes.getNamedItem("codeArticle").Text = tbCodeArticle.Text And tbCodeArticle.Text <> "" Then
            res = MsgBox("Un autre équipement possède la même référence ou le même code article, voulez-vous l'écraser ?", vbQuestion + vbYesNo)
            If res = vbNo Then
                Exit Sub
            Else
                xmlNodeRoot.removeChild xmlNodeOldEq
                Exit For
            End If
        End If
    Next
 
    Set buffer = xmlNodeRoot.appendChild(xmlNodeNewEq)
 
    If Worksheets("donnees").Range("L1").Value = "" Then
        Load configCheminXML
        configCheminXML.Show (vbModal)
    End If
 
    xmlDoc.Save Worksheets("donnees").Range("L1").Value + "\ListeMux.xml"
 
    Unload Me

et un autre exemple

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
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
Private Sub sauvegarderSynoptiquesXML()
 
    Dim xmlDoc As MSXML2.DOMDocument
    Dim xmlNodeRoot As MSXML2.IXMLDOMNode
    Dim xmlNodeNewSynoptique As MSXML2.IXMLDOMElement
    Dim xmlNodeOldSynoptique As MSXML2.IXMLDOMElement
    Dim xmlNodeNewService As MSXML2.IXMLDOMElement
    Dim siteExiste As Boolean
    Dim NomUtilisateur As String
    Dim nomSite As String
    Dim nbPS As Integer
    Dim ligne As Integer
 
    ' --------------------------------------------
    Set xmlDoc = New DOMDocument ' objet xml
    xmlDoc.Async = False
 
    ' Verification de l'existance du répertoire enregistré dans le fichier excel
    Set fs = CreateObject("Scripting.FileSystemObject")
    If Not fs.FolderExists(Worksheets("donnees").Range("L1").Value) Then
        res = MsgBox("Le chemin vers les sauvegardes est introuvable !", vbExclamation + vbOKOnly)
        Load configCheminXML
        configCheminXML.Show (vbModal)
    End If
 
    xmlDoc.Load xmlSource:=Worksheets("donnees").Range("L1").Value + "\Synoptiques.xml" ' charge le ficher
 
    ' --------------------------------------------
    ' Vérification de l'existance du noeud principal
    If Not xmlDoc.hasChildNodes Then
        Set xmlNodeRoot = xmlDoc.createElement("Synoptiques") ' création du noeud racine si il n'existe pas deja
        xmlDoc.appendChild xmlNodeRoot ' ajout du noeud racine au document
    End If
 
    ' --------------------------------------------
    ' Si la combobox contenant le nom du site est vide on demande le nom du site
    If cbNomSite.Text = "" Then
        nomSite = InputBox("Veuillez indiquer le nom du site", "Nom du site", Worksheets("donnees").Cells(1, 8).Text)
        If nomSite = "" Then ' tant que rien n'a été indiqué, on continue à demander
            res = MsgBox("Il est nécessaire d'entrer un nom de site pour pouvoir enregistrer." + vbCrLf + _
                "Rien n'a été sauvegardé...", vbExclamation)
            Exit Sub
        End If
        cbNomSite.Text = nomSite
    End If
 
    ' --------------------------------------------
    ' Vérification de l'existance du site
    Set xmlNodeRoot = xmlDoc.selectSingleNode("Synoptiques") ' sélection du noeud racine
    ' Selection du noeud correspondant au nom du site
    ' si ce noeud est inexistant xmlNode = nothing
    Set xmlNodeOldSynoptique = xmlNodeRoot.selectSingleNode("//Synoptiques/Synoptique[@site='" + Replace(cbNomSite.Text, "'", "\'") + "']")
    ' --------------------------------------------
    ' Le site existe
    siteExiste = True
    If xmlNodeOldSynoptique Is Nothing Then siteExiste = False
 
    If siteExiste Then
        ' Affichage d'une boite de dialogue pour confirmation
        rep = MsgBox("Le site """ + cbNomSite.Text + """ existe déjà, le mettre à jour ?", vbYesNo + vbExclamation)
        If rep = vbNo Then
            Exit Sub
        End If
    End If
 
    ' --------------------------------------------
    ' Demande le nom du responsable
    NomUtilisateur = InputBox("Veuillez indiquer votre nom", "Nom du responsable", Application.UserName)
    If NomUtilisateur = "" Then ' tant que rien n'a été indiqué, on continue à demander
        res = MsgBox("Il est nécessaire d'entrer un nom pour pouvoir enregistrer." + vbCrLf + _
            "Rien n'a été sauvegardé...", vbExclamation)
        Exit Sub
    End If
 
    ' --------------------------------------------
    ' Vérification du nombre de services
    nbPS = DerniereCelluleColonne(ThisWorkbook.Name, "donnees", "A1").Row - 2
    If nbPS < 1 Then
        res = MsgBox("Il n'y a aucun service dans la feuille ""donnees"", le synoptique est vide", vbExclamation)
        Exit Sub
    End If
 
    ' --------------------------------------------
    ' On créé l'arborescence du nouveau noeud
    Set xmlNodeNewSynoptique = xmlDoc.createElement("Synoptique")
    xmlNodeNewSynoptique.setAttribute "site", cbNomSite.Text
    xmlNodeNewSynoptique.setAttribute "codeIG", Worksheets("donnees").Cells(ligne + 2, 19).Value
    xmlNodeNewSynoptique.setAttribute "dateMaj", Format(Now, "dd mmmm yyyy hh:nn", vbMonday)
    xmlNodeNewSynoptique.setAttribute "responsable", NomUtilisateur
    If Worksheets("donnees").Range("H10").Value = "" Then Worksheets("donnees").Range("H10").Value = "Non"
    xmlNodeNewSynoptique.setAttribute "synoEnProd", Worksheets("donnees").Range("H10").Value
    Set buffer = xmlNodeRoot.appendChild(xmlNodeNewSynoptique)
 
    For ligne = 0 To nbPS - 1
        Set xmlNodeNewService = xmlDoc.createElement("Service")
        xmlNodeNewService.setAttribute "nom", Worksheets("donnees").Cells(ligne + 2, 1).Text
        xmlNodeNewService.setAttribute "freq", Worksheets("donnees").Cells(ligne + 2, 2).Value
        xmlNodeNewService.setAttribute "pFonc", Worksheets("donnees").Cells(ligne + 2, 3).Value
        xmlNodeNewService.setAttribute "refMux", Worksheets("donnees").Cells(ligne + 2, 4).Value
        xmlNodeNewService.setAttribute "antenne", Worksheets("donnees").Cells(ligne + 2, 5).Value
        xmlNodeNewService.setAttribute "gain", Worksheets("donnees").Cells(ligne + 2, 6).Value
 
        xmlNodeNewService.setAttribute "cheminPJ5", Worksheets("donnees").Cells(ligne + 2, 12).Value
 
        xmlNodeNewService.setAttribute "cablePrincipalRef", Worksheets("donnees").Cells(ligne + 2, 13).Value
        xmlNodeNewService.setAttribute "cablePrincipalLong", Worksheets("donnees").Cells(ligne + 2, 14).Value
        xmlNodeNewService.setAttribute "cableSecondaireRef", Worksheets("donnees").Cells(ligne + 2, 15).Value
        xmlNodeNewService.setAttribute "cableSecondaireLong", Worksheets("donnees").Cells(ligne + 2, 16).Value
        xmlNodeNewService.setAttribute "cableRepartitionRef", Worksheets("donnees").Cells(ligne + 2, 17).Value
        xmlNodeNewService.setAttribute "cableRepartitionLong", Worksheets("donnees").Cells(ligne + 2, 18).Value
 
        xmlNodeNewService.setAttribute "typeAntenne", Worksheets("donnees").Cells(ligne + 2, 20).Value
        xmlNodeNewService.setAttribute "hmaAntenne", Worksheets("donnees").Cells(ligne + 2, 21).Value
 
        Set buffer = xmlNodeNewSynoptique.appendChild(xmlNodeNewService)
    Next
 
    ' --------------------------------------------
    ' On enregistre le(s) synoptique(s)
    If Not xmlNodeOldSynoptique Is Nothing Then
 
        xmlNodeRoot.removeChild xmlNodeOldSynoptique
 
    End If
 
    If Worksheets("donnees").Range("L1").Value = "" Then
        Load configCheminXML
        configCheminXML.Show (vbModal)
    End If
 
    xmlDoc.Save Worksheets("donnees").Range("L1").Value + "\Synoptiques.xml"
 
    Worksheets("donnees").Unprotect ("tdf")
    Worksheets("donnees").Range("H14").Value = Now
    Worksheets("donnees").Range("H1").Value = cbNomSite.Text
    Call miseEnPagePrincipale
    Application.ScreenUpdating = True
 
    Call UserForm_Initialize
 
End Sub

**Godzestla** · 28/11/2008, 09h55

Génial.

je te remercie 10000000000000000 fois.

Impossible pour moi de me pencher la-dessus actuellement mais je te contacte dans quelques temps si j'ai besoin de quelques précisons.

En tout cas merci pour ce partage. J'apprécie vraiment.