Bonjour à tous !

J'essaie de créer un fichier XML selon un modèle qui m'a été fourni. Mes pérégrinations sur la toile m'ont permis d'élaborer le code que je vous donnerai ci-après. Toutefois, mes connaissances limitées dans la vaste jungle d'objets XML permettant de générer ce genre de fichier ont donné naissance à un mix up un peu confus et certainement pas très efficient.

Le fichier que l'on me demande :
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
<?xml version="1.0" encoding="UTF-8"?>
<?xml-stylesheet type="text/xsl" href="CLIENT_TOTO.xslt"?>
<FLUX xmlns="http://www.toto.com/appli" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xsi:schemaLocation"http://www.toto.com/appli CLIENT_TOTO.xsd">
	<CLIENT>TOTO</CLIENT>
	<DEMANDES>
		<DEMANDE xsi:type="DEMARRAGE">
			<NUMERO>ID01</NUMERO>
			<CONTRAT>
				<TEL>024568763</TEL>
			</CONTRAT>
		</DEMANDE>
		<DEMANDE xsi:type="DEMARRAGE">
			<NUMERO>ID02</NUMERO>
			<CONTRAT>
				<TEL>84251359</TEL>
			</CONTRAT>
		</DEMANDE>
	</DEMANDES>
</FLUX>
Attention, voici le gros morceau. Le code que je suis parvenu à assembler bon an, mal an. Notez également qu'à cause de la censure que j'ai appliquée, il peut y avoir quelques incohérences. Le script fonctionne et je vous donnerai une idée de ses résultats ensuite.

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
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
Option Explicit
 
Sub Activation()
    Dim TypeDemande
    TypeDemande = "Démarrage"
    Initialize ("Démarrage")
End Sub
 
Sub Initialize(TypeDemande)
    Dim CompletePath, Destination, Filename, i, Feuille, Limite, Client
    Dim Prefixe, Result, NbDemandes
    Dim fs, f, ts, XML, XMLFileObject, XMLFile
    Set fs = CreateObject("Scripting.FileSystemObject")
 
    Prefixe = "CLIENT"
    Filename = Prefixe & "TOTO.xml"
    CompletePath = Destination & "\" & Filename
 
    i = 4
    Set Feuille = ThisWorkbook.Sheets(2)
 
    While Feuille.Cells(i, 1) <> "" And Feuille.Cells(i, 2) <> ""
        i = i + 1
    Wend
    If Feuille.Cells(i, 1) = "" And (Feuille.Cells(i, 2) <> "" Or Feuille.Cells(i, 2) <> "") _
        And NbDemandes < Limite + 1 Then
            XML = ThisWorkbook.StructureXML(Destination, Filename, Client)
            While Feuille.Cells(i, 1) = "" And (Feuille.Cells(i, 2) <> "" Or Feuille.Cells(i, 2) <> "") _
                And NbDemandes < Limite + 1
                    TEL = Feuille.Cells(i, 2)
                    Result = ThisWorkbook.DemandeXML(CompletePath, TypeDemande, TEL)
                    ' Feuille.Cells(i, 1).Value = "Créée"
                    NbDemandes = NbDemandes + 1
                    i = i + 1
            Wend
 
            ' Méthode d'indentation n°1
            XMLFile = ThisWorkbook.BeautifyXML(CompletePath)
            Set XMLFileObject = fs.OpenTextFile(CompletePath, 2)
            XMLFileObject.Write XMLFile
            XMLFileObject.Close
 
            ' Méthode d'indentation n°2
            ' ThisWorkbook.IndentXML CompletePath, True, True
 
    Else
        MsgBox "Aucune donnée disponible pour la création de fichier XML."
        End
    End If
 
End Sub
 
Public Function StructureXML(Destination, Filename, Client) As Variant
 
    Dim fs, f, XML, XNodeBranche, XFeuille, XNode
    Set fs = CreateObject("Scripting.FileSystemObject")
    If Not fs.FolderExists(Destination) Then
        StructureXML = "Répertoire inexistant"
        End
    Else
        Dim objDOM As DOMDocument
        Dim XNodeRoot, Demandes_node As IXMLDOMElement
        Dim oPi As IXMLDOMProcessingInstruction
        Set objDOM = New DOMDocument
 
        objDOM.resolveExternals = True
        Set oPi = objDOM.createProcessingInstruction("xml", "version=""1.0"" encoding=""UTF-8""")
        Set oPi = objDOM.insertBefore(oPi, objDOM.childNodes.Item(0))
        Set oPi = objDOM.createProcessingInstruction("xml-stylesheet", "type=""text/xsl"" href=""CLIENT_TOTO.xslt""")
        Set oPi = objDOM.insertBefore(oPi, objDOM.childNodes.Item(1))
        'Root
        Set XNodeRoot = objDOM.createElement("FLUX")
        XNodeRoot.setAttribute "xmlns", "http://www.toto.com/appli"
        XNodeRoot.setAttribute "xmlns:xsi", "http://www.w3.org/2001/XMLSchema-instance"
        XNodeRoot.setAttribute "xsi:schemaLocation", "http://www.toto.com/appli CLIENT_TOTO.xsd"
 
        objDOM.appendChild XNodeRoot
 
        Set XNodeBranche = objDOM.createNode(1, "CLIENT", "")
        Set XFeuille = objDOM.createTextNode("TOTO")
        XNodeBranche.appendChild XFeuille
        XNodeRoot.appendChild XNodeBranche
        Set Demandes_node = XNodeBranche.ownerDocument.createElement("DEMANDES")
        XNodeRoot.appendChild Demandes_node
 
        objDOM.Save Destination & "\" & Filename
        Set XNodeRoot = Nothing
        Set XNode = Nothing
        Set objDOM = Nothing
        StructureXML = True
    End If
End Function
 
Public Function DemandeXML(CompletePath, TypeDemande, TEL)
 
    Dim CodeMotif, LoadResult
    Dim objDOM As DOMDocument
    Dim XNodeRoot, Demande_node, Demandes_node As IXMLDOMElement
    Dim Children As IXMLDOMNodeList
    Set objDOM = New DOMDocument
    objDOM.async = False
    LoadResult = objDOM.Load(CompletePath)
    Set Demandes_node = objDOM.selectSingleNode("/FLUX/DEMANDES")
 
    Select Case TypeDemande
        Case "DEMARRAGE"
            Test = False
    End Select
 
    Set Demande_node = Demandes_node.ownerDocument.createElement("DEMANDE")
    Demande_node.setAttribute "xsi:type", "DEMARRAGE"
    Demandes_node.appendChild Demande_node
 
    objDOM.Save CompletePath
    DemandeXML = True
 
End Function
 
Function BeautifyXML(XMLFile)
    Dim xmlDoc As New DOMDocument40
    'Create the reader.
    Dim rdr As New SAXXMLReader40
    'Create the writer.
    Dim wrt As New MXXMLWriter40
 
    'Load the DOM document.
    xmlDoc.async = False
    xmlDoc.resolveExternals = False
    xmlDoc.Load (XMLFile)
 
    'Set properties on the XML writer.
    wrt.byteOrderMark = True
    wrt.omitXMLDeclaration = False
    wrt.indent = True
 
    'Set the XML writer to the SAX content handler.
    Set rdr.contentHandler = wrt
    Set rdr.dtdHandler = wrt
    Set rdr.errorHandler = wrt
    rdr.putProperty "http://xml.org/sax/properties/lexical-handler", wrt
    rdr.putProperty "http://xml.org/sax/properties/declaration-handler", wrt
 
    'Parse the DOMDocument object.
    rdr.Parse xmlDoc
 
    BeautifyXML = wrt.output
End Function
 
Public Sub IndentXML(CompletePath, Optional bUnindent As Boolean, Optional bLeaveHeader As Boolean)
    Dim oXMLDoc     As DOMDocument
    Dim oXSLT       As DOMDocument
    Dim XSL_FILE    As String
    Dim sResult     As String
    Dim sIndent     As String
    Dim LoadResult
    Const QT = """"
 
    Set oXMLDoc = New DOMDocument
    oXMLDoc.async = False
    LoadResult = oXMLDoc.Load(CompletePath)
 
 
    Set oXSLT = New DOMDocument
 
    If bUnindent Then
        sIndent = "no"
    Else
        sIndent = "yes"
    End If
 
    XSL_FILE = _
            "<?xml version=" & QT & "1.0" & QT & " encoding=" & QT & "UTF-8" & QT & "?>" & vbCrLf & _
            "<xsl:stylesheet version=" & QT & "1.0" & QT & " xmlns:xsl=" & QT & "http://www.w3.org/1999/XSL/Transform" & QT & ">" & vbCrLf & _
            "     <xsl:output method=" & QT & "xml" & QT & " version=" & QT & "1.0" & QT & " encoding=" & QT & "UTF-8" & QT & " indent=" & QT & sIndent & QT & "/>" & vbCrLf & _
            "     <xsl:template match=" & QT & "@* | node()" & QT & ">" & vbCrLf & _
            "          <xsl:copy>" & vbCrLf & _
            "               <xsl:apply-templates select=" & QT & "@* | node()" & QT & " />" & vbCrLf & _
            "          </xsl:copy>" & vbCrLf & _
            "     </xsl:template>" & vbCrLf & _
            "</xsl:stylesheet>"
 
 
    oXMLDoc.async = False
    oXSLT.async = False
 
    oXSLT.loadXML XSL_FILE
 
    If oXSLT.parseError.errorCode = 0 Then
        If oXSLT.readyState = 4 Then
            sResult = oXMLDoc.transformNode(oXSLT.documentElement)
 
            ' Get rid of the added header line
            If Not bLeaveHeader Then
                sResult = Replace$(sResult, "<?xml version=" & QT & "1.0" & QT & " encoding=" & QT & "UTF-16" & QT & "?>", vbNullString, , , vbTextCompare)
            End If
            oXMLDoc.loadXML sResult
            oXMLDoc.Save CompletePath
        End If
    Else
        Err.Description = oXSLT.parseError.reason & vbCrLf & _
        "Line: " & oXSLT.parseError.Line & vbCrLf & _
        "XML: " & oXSLT.parseError.srcText
        Err.Raise 1006
    End If
 
    Set oXSLT = Nothing
 
End Sub
A la suite de ça j'obtiens ceci :

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
<?xml version="1.0" encoding="UTF-8"?>
<?xml-stylesheet type="text/xsl" href="CLIENT_TOTO.xslt"?>
<FLUX xmlns="http://www.toto.com/appli" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xsi:schemaLocation="http://www.toto.com/appli CLIENT_TOTO.xsd"><CLIENT>TOTO</CLIENT><DEMANDES><DEMANDE xmlns="" xsi:type="DEMARRAGE"></DEMANDE><DEMANDE xmlns="" xsi:type="DEMARRAGE"><CODE_MOTIF>1</CODE_MOTIF></DEMANDE></DEMANDES></FLUX>
Comme vous pouvez le voir, le résultat n'est pas indenté (normal à ce que j'ai compris avec l'objet utilisé) et on m'a rajouté des attributs xmlns et je ne comprends pas d'où ils viennent.

Si vous êtes intéressés par les résultats des fonctions d'indentation, je peux les donner également, mais pour faire court :
  1. La première me bousille l'en-tête.
  2. La seconde change l'ordre des attributs dans l'en-tête et me rajoute une balise auto-ns1 là où il y avait déjà des xmlns en trop.


Merci d'avance pour votre aide. J'ai bien conscience que le problème réside à la fois dans ma connaissances du XML (namespaces entre autres) et des objets utilisés (DOMDocument et consort).

Merci également de me prévenir si j'ai oublié par mégarde de censurer certains passages...

Remarque complémentaire : J'ai déjà réussi à créer ces fichiers en VBScript, grâce à un objet XMLUtil (XMLUtil.CreateXML()), et XMLObj = CreateObject("Microsoft.XMLDOM") pour créer les processing instructions.