Probleme entre VBS et XML

**Menontona** · 17/06/2009, 21h04

Bonjour,

J'ai écrit un script en VBS, en m'inspirant d'un des tutorial du forum, qui génére un document XML. Je cherche à rendre le nombre de classe, d'entité, d'attribut de ce document dynamique. Quelque soit le nombre de classe, tant qu'il est supérieur à 1, le document XML généré n'est composé que de la dernière classe.

Voici mon code VBS :

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
Function Valide(ByVal phrase)
    Dim regEx , occurrences
    Set regEx = New RegExp
    regEx.Pattern = "[a-z0-9]"
    regEx.IgnoreCase = True 'Ne pas distinguer les minuscules des majuscules
    regEx.Global = False 'Renvoyer seulement la première occurrence
    Set occurrences = regEx.Execute(phrase)
    Valide = (occurrences.Count = 1)
End Function
 
Do While reponse <> 6
Nombre_Classe = inputBox("Entrez le nombre de classe désiré :", "Quel est le nombre de classe désiré ?")
If (Nombre_Classe <> "" AND IsNumeric(Nombre_Classe)) then
Reponse = MsgBox ("Le nombre de classe désiré est de " & Nombre_Classe & ". Est-ce exact ?", vbQuestion+vbYesNo, "Confirmation")
End if
Loop
 
Nom_Classe = array()
redim Nom_Classe(Nombre_Classe - 1)
 
For k = 0 to Nombre_Classe - 1
 
Reponse = 0
Do While reponse <> 6
Nom_Classe(k) = inputBox("Entrez le nom de la classe numéro " & k+1 & " :", "Quel est le nom de la classe numéro " & k+1 & " ?")
If (Nom_Classe(k) <> "") then
Reponse = MsgBox ("Le nom de votre classe est '" & Nom_Classe(k) & "'. Est-ce exact ?", vbQuestion+vbYesNo, "Confirmation")
End if
Loop
 
Reponse = 0
Do While reponse <> 6
Nombre_Entite = inputBox("Combien d'entité de cette classe désirez-vous créer :", "Quel est le nombre désirez d'entité de cette classe ?")
If (Nombre_Entite <> "" AND IsNumeric(Nombre_Entite)) then
Reponse = MsgBox ("Le nombre d'entité est de " & Nombre_Entite & ". Est-ce exact ?", vbQuestion+vbYesNo, "Confirmation")
End if
Loop
 
Entite = array()
redim Nom_Entite(Nombre_Entite - 1)
 
Reponse = 0
Do While reponse <> 6
Nombre_Attribut = inputBox("Entrez le nombre d'attribut de la classe :", "Quel est le nombre d'attribut de votre classe ?")
If (Nombre_Attribut <> "" AND IsNumeric(Nombre_Attribut)) then
Reponse = MsgBox ("Le nombre d'attributs est de " & Nombre_Attribut & ". Est-ce exact ?", vbQuestion+vbYesNo, "Confirmation")
End if
Loop
 
Nom_Attribut = array()
redim Nom_Attribut(Nombre_Attribut - 1)
 
Reponse = 0
For i = 0 to Nombre_Entite - 1
Do While reponse <> 6
Nom_Entite(i) = inputBox ("Entrez le nom de l'entité numéro :" & i+1 & ". Attention, ce nom ne doît pas commencer par un chiffre et n'accepte pas les caractères spéciaux." , "Quel est le nom de l'entité numéro " & i+1 & " ?")
If (Nom_Entite(i) <> "" AND Not IsNumeric(Left(Nom_Entite(i),1)) AND Valide(Nom_Entite(i))) then
Reponse = MsgBox ("Le nom de l'entité numéro " & i+1 & " est '" & Nom_Entite(i) & "'. Est-ce exact ?", vbQuestion+vbYesNo, "Confirmation")
End if
Loop
reponse = 0
Next
 
Reponse = 0
For i = 0 to Nombre_Attribut - 1
Do While reponse <> 6
Nom_Attribut(i) = inputBox ("Entrez le nom de l'attribut numéro " & i+1 & ". Attention, ce nom ne doît pas commencer par un chiffre, n'accepte pas les caractères spéciaux ni les espaces.","Quel est le nom de l'attribut numéro " & i+1)
If (Nom_Attribut(i) <> "" AND Not IsNumeric(Left(Nom_Attribut(i),1)) AND Valide(Nom_Attribut(i))) then
Reponse = MsgBox ("Le nom de l'attribut numéro " & i+1 & " est '" & Nom_Attribut(i) + "'. Est-ce exact ?", vbQuestion+vbYesNo, "Confirmation")
End if
Loop
reponse = 0
Next
 
Set xmlDoc = CreateObject("Microsoft.XMLDOM")
Set oCreation = xmlDoc.createProcessingInstruction("xml", "version='1.0' encoding='ISO-8859-1'")
xmlDoc.insertBefore oCreation, xmlDoc.childNodes.Item(0)
 
Set Element = xmlDoc.createElement(Nom_Classe(k))
xmlDoc.appendChild(Element)
 
Reponse = 0
For i = 0 to (Nombre_Entite - 1)
Set NomEntite = xmlDoc.createElement(Nom_Entite(i))
For j = 0 to (Nombre_Attribut - 1)
Do While reponse <> 6
Set Valeur_attribut = xmlDoc.createElement(Nom_Attribut(j))
Valeur_attribut.Text = inputBox ("Entrez la valeur de l'attribut '"& Nom_Attribut(j) & "' de l'entité '" & Nom_Entite(i) & "'" , "Quel est la valeur de cet attribut ?")
If (Valeur_attribut.Text <> "") then
Reponse = MsgBox("La valeur de l'attribut '"& Nom_Attribut(j) & "' de l'entité '" & Nom_Entite(i) & "' est '" & Valeur_attribut.Text & "', est-ce exact ?",vbQuestion+vbYesNo, "Confirmation")
End if
Loop
NomEntite.appendChild(Valeur_attribut)
Reponse = 0
Next
Next
 
Element.appendChild(NomEntite)
Set rdr = CreateObject("MSXML2.SAXXMLReader")
Set wrt = CreateObject("MSXML2.MXXMLWriter")
Set oStream = CreateObject("ADODB.STREAM")
oStream.Open
oStream.Charset = "ISO-8859-1"
 
wrt.indent = True
wrt.encoding = "ISO-8859-1"
wrt.output = oStream
Set rdr.contentHandler = wrt
Set rdr.errorHandler = wrt
rdr.Parse xmlDoc
wrt.flush
Next
 
Do While reponse <> 6
Nom = inputBox("Entrer le nom du document XML à enregistrer :", "Quel est le nom du document XML ?")
If ( Nom <> "") then
Reponse = MsgBox("Le nom du document XML est '" & Nom & "', est-ce exact ?",vbQuestion+vbYesNo, "Confirmation")
End if
Loop
 
oStream.SaveToFile Nom + ".xml", 2
 
Set rdr = Nothing
Set wrt = Nothing
Set xmlDoc = Nothing

Quelqu'un peut-il m'aider à pallier ce problème car je n'arrive pas à le résoudre.

Merci d'avance
Menontona

**SfJ5Rpw8** · 17/06/2009, 21h15

difficile à lire ton code ... il faudrait l'indenter un peu ..

il est ou ton appenchild ( Nom de la classe ) ?

**Menontona** · 17/06/2009, 21h34

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
Set xmlDoc = CreateObject("Microsoft.XMLDOM")
Set oCreation = xmlDoc.createProcessingInstruction("xml", "version='1.0' encoding='ISO-8859-1'")
xmlDoc.insertBefore oCreation, xmlDoc.childNodes.Item(0)
 
Set Element = xmlDoc.createElement(Nom_Classe(k))
xmlDoc.appendChild (Element)
 
Reponse = 0
For i = 0 To (Nombre_Entite - 1)
    Set NomEntite = xmlDoc.createElement(Nom_Entite(i))
    For j = 0 To (Nombre_Attribut - 1)
        Do While Reponse <> 6
            Set Valeur_attribut = xmlDoc.createElement(Nom_Attribut(j))
            Valeur_attribut.Text = InputBox("Entrez la valeur de l'attribut '" & Nom_Attribut(j) & "' de l'entité '" & Nom_Entite(i) & "'", "Quel est la valeur de cet attribut ?")
            If (Valeur_attribut.Text <> "") Then
                Reponse = MsgBox("La valeur de l'attribut '" & Nom_Attribut(j) & "' de l'entité '" & Nom_Entite(i) & "' est '" & Valeur_attribut.Text & "', est-ce exact ?", vbQuestion + vbYesNo, "Confirmation")
            End If
        Loop
        NomEntite.appendChild (Valeur_attribut)
        Reponse = 0
    Next
Next
 
Element.appendChild (NomEntite)
Set rdr = CreateObject("MSXML2.SAXXMLReader")
Set wrt = CreateObject("MSXML2.MXXMLWriter")
Set oStream = CreateObject("ADODB.STREAM")
oStream.Open
oStream.Charset = "ISO-8859-1"
 
wrt.indent = True
wrt.encoding = "ISO-8859-1"
wrt.output = oStream
Set rdr.contentHandler = wrt
Set rdr.errorHandler = wrt
rdr.Parse xmlDoc
wrt.flush
Next
 
Do While Reponse <> 6
    Nom = InputBox("Entrer le nom du document XML à enregistrer :", "Quel est le nom du document XML ?")
    If (Nom <> "") Then
        Reponse = MsgBox("Le nom du document XML est '" & Nom & "', est-ce exact ?", vbQuestion + vbYesNo, "Confirmation")
    End If
Loop
 
oStream.SaveToFile Nom + ".xml", 2
 
Set rdr = Nothing
Set wrt = Nothing
Set xmlDoc = Nothing