Import XML (attribute-centric) volumineux avec VBA

Version imprimable

1 pièce(s) jointe(s)

Bonjour,

j'ai feuilleté les différents tutos permettant d'importer des fichiers XML notamment celui ci:
http://arkham46.developpez.com/artic...ge=page_4#L5-B
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 'Voir arborescence du fichier Function ReadXMLFileXMLIndent() Dim oXML As MSXML2.DOMDocument Dim oNode As MSXML2.IXMLDOMNode Set oXML = New MSXML2.DOMDocument oXML.async = False oXML.Load "C:\****\exportbis.xml" For Each oNode In oXML.DocumentElement.ChildNodes Debug.Print oNode.BaseName Next End Function
j'ai un message comme quoi la variable objet n'est pas définie. comme je débute dans ce type de traitement je ne comprends pas d'où vient le problème d'autant que j'ai chargé la référence Microsoft XML 6.:calim2:

Du coup j'ai essayé le code source ci-dessous (trouvé sur http://www.access-programmers.co.uk/...d.php?t=213209) avec le fichier xml en pièce jointe ici Pièce jointe 216056

en testant dans ma base Access aucun message d'erreurs (j'ai aussi compiler mon projet vba) mais aucun import de données non plus dans la table :weird:
j'ai vérifié les liens des fichiers et le nom des variables, des champs et des tables pourtant et je suis (presque) sur que c'est correct.
Code:

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 'Importer des fichiers XML dans Access lorsque ceux ci utilisent des attribut. Public Sub ImportXML2() Dim xmlDoc As MSXML2.DOMDocument Dim franchiseNode As MSXML2.IXMLDOMNode Dim playerNode As MSXML2.IXMLDOMNode Dim rs As DAO.Recordset Set rs = CurrentDb.OpenRecordset("rosters") Set xmlDoc = New MSXML2.DOMDocument With xmlDoc .Load "C:\***\export.xml" If .parseError.ErrorCode <> 0 Then MsgBox "Error loading: " & .parseError.reason 'need to exit gracefully here End If For Each franchiseNode In .FirstChild.ChildNodes For Each playerNode In franchiseNode.ChildNodes rs.AddNew rs!franchise = franchiseNode.Attributes.getNamedItem("id").Text rs!player = playerNode.Attributes.getNamedItem("id").Text rs!Status = playerNode.Attributes.getNamedItem("status").Text rs.Update Next playerNode Next franchiseNode End With Set xmlDoc = Nothing Set franchiseNode = Nothing Set playerNode = Nothing Set rs = Nothing End Sub
en mettant des debug.print un peu partout j'ai l'impression que la boucle ne marche pas ou que la fonction ne trouve pas les noeuds. :traine:
J'ai du passé à côté de quelque chose mais je ne vois pas quoi... je n'en suis qu'à des traitements simples alors que ce que je cherche à faire est beaucoup plus complexe.:aie: Donc si quelqu'un pouvait me mettre sur la voie en me fournissant une base de travail toute faite avec un fichier xml (possédant plusieurs attributs différents pour chaque noeud) et un code source simple qui fonctionne ça m'arrangerait pour la suite qui s'avère plus compliqué.

Petite précision pour la suite : le fichier xml que je souhaite importer fait 110 mo et comporte 2 600 000 de lignes (je ne m'intéresserait qu'à certaines informations à l'intérieur mais ça va représenter un gros volume de données...) donc si vous avez des suggestions pour éviter que les traitements prennent trop longtemps je suis preneur car l'optimisation de code et moi ça fait deux :pastaper:

un grand merci d'avance à celui qui me sortira du pétrin

Bonjour,

Code:

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
Public Function LoadRsFromXML(FullPath As String) As Object
 
'**************************************************
'PURPOSE: LOAD A RECORDSET FROM AN XML FILE USING
'ADO 2.5.  THE XML FILE MUST HAVE BEEN SAVED
'USING SAVE METHOD OF RECORDSET OBJECT WITH adPersistXML AD
'SECOND PARAMETER
 
'PARAMETERS:
 'FullPath:     FullPath of XMLFile to load
 
'RETURNS:       Reference to a Recordset Object, or Nothing if
'               Function fails
'REQUIRES:      Installation of and reference to ADO 2.5
'EXAMPLE:       See Example for SaveRsToXML
 
'******************************************************
 
Dim oRs As Object, adoConn As Object
Set GetXMLDB = CreateObject("ADODB.Connection")
 
With GetXMLDB
.Open "Provider=MSDAOSP; Data Source=MSXML2.DSOControl;"
End With
Set oRs = CreateObject("ADODB.Recordset")
On Error Resume Next
Const adCmdFile = 256
Const adOpenForwardOnly = 0
Const adLockReadOnly = 1
If Dir(FullPath) = "" Then Exit Function
oRs.Open FullPath, GetXMLDB
 
If Err.Number = 0 Then
    Set LoadRsFromXML = oRs
End If
 
End Function
Sub test()
Dim Rs As Object
Set Rs = LoadRsFromXML("C:\****\exportbis.xml")
If TypeName(Rs) = "Nothing" Then Exit Sub
While Rs.EOF = False
'    InsertAccess Rs
    Rs.movenext
Wend
End Sub

22/07/2016, 20h17
benji971

Bonjour,

Merci pour le code source. j'ai jeter un œil mais j'avoue que je préfère l'approche par XML DOM ou XPATH qui a l'air plus facile.
notamment parce que je ne vois pas trop comment récupérer les attributs avec ADO 2.5 :?

Quelle méthode est la plus avantageuse/rapide d'ailleurs par rapport au volume de donnée que je dois traiter ?

j'ai trouvé des codes sources qui ont l'air de fonctionner ici:
http://analystcave.com/vba-xml-working-xml-files/

je posterais un exemple de code source qui fonctionne avec un fichier xml lorsque j'aurais fait quelques tests.
mais je pense que mon problème précédent venait surtout de la structure du fichier xml que j'utilisais et qui semblait invalide... :pan:
j'ai eu un résultat différent avec un autre modèle xml pris sur internet.
25/07/2016, 19h15
User

Bonjour,

C'est pas simple d'alimenter une table Access en important un xml :

Pour info, par exemple sous Excel, la méthode ImportXML est quand même assez sophistiquée, car elle reconnait les noeuds enfants de même nature (<Hit>..</Hit> dans le fichier xml) et est capable de décider qu'il faut changer de ligne en recopiant tout ce qui est commun.

...

Cdlt,
25/07/2016, 19h58
benji971

1 pièce(s) jointe(s)

Bonjour,

Finalement après m'être documenté, pour les fichiers volumineux il vaut mieux à priori passer par SAX plutôt que par XML DOM.
je ne sais pas ce que ça vaut je suis en train de tester.
j'ai réussi à créer ma class ContentHandler et à récupérer une balise ainsi que des attributs spécifiques mais je pense que je vais bientôt bloquer sur la gestion des erreurs ou l'alimentation de la table à partir des données extraites. je ne sais pas trop s'il vaut mieux dans ce cas utiliser SAX Writer ou plutôt se contenter de lire le fichier xml puis de mettre des flag (variable boolean) et stocker les infos recueillis dans une ou plusieurs variables avant de les réinjecter via un recordset. Ou bien carrément établir une connexion à SQL server et alimenter une table SQL.

Quelqu'un a déjà eu à utiliser SAX par hasard sur le forum ?

Pour plus de clarté, ci-joint le fichier type que je dois importer dans Access (ou directement dans une base SQL server si ça représente trop de données) :
Pièce jointe 216336

je n'ai conserver qu'un enregistrement sur les 22 000 lignes ref que je dois extraire pour simplifier et faire les premiers tests.

la structure normalement ne devrait pas changer.
sur le principe je vais donc extraire :
- le code ean => Colonne ean
- J'aurais pour chaque caractéristique produit (balise <c##>) quelque chose qui se rapprochera de ça:
"valeur de l'attribut "fr" contenu dans la balise <c##>" & ":" & "valeur de la balise fille <fr> " & "<br>"
Le but ici est de pouvoir réimporter l'ensemble des caractéristiques d'un produit dans une seule cellule Access (donc boucle + concaténage des carac. dans une seule variable j'imagine).
-Extraction du nom de l'image contenu dans la balise <image>
-Extraction des noms de fichiers contenus dans les balises <fichier type="image">
-Extraction des noms de fichiers contenus dans les balises <fichier type="Fiche fabriquant">

Si quelqu'un a l'habitude de SAX ça m'intéresserait d'avoir son avis afin de ne pas partir dans une mauvaise direction.
j'ai surtout peur que la fonction VBA plante devant le volume de données traités ou que le traitement soit beaucoup trop long...

Pour ceux qui veulent comprendre comment SAX fonctionne il suffit de copier coller le premier code dans un module normal et le second dans un module de classe appelé "ContentHandler" (et se servir du dernier fichier xml que j'ai joint au sujet). Il faut aussi activer la référence à microsoft XML 3.0.

Mon code source si une âme charitable passe par là pour l'optimiser ou corriger les erreurs :

D'abord la fonction qui appelle la classe :

Code:

1
2
3
4
5
6
7
Public Sub Reader1_Click()
    Dim rdr As New SAXXMLReader40
    Dim cnth As New ContentHandler
    Set rdr.ContentHandler = cnth
    rdr.parseURL "C:\***\****\test.xml"
 
End Sub

et ci-dessous ma classe ContentHandler:

Code:

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
Option Compare Database
 
'les flag me permettant de savoir où on se situe dans le traitement.
Private IsFichier As Boolean
Private IsImage As Boolean
Private IsEan As Boolean
Private IsCarac As Boolean
Private IsValueCarac As Boolean
Private IntCarac As Integer
Private LineIndex As Integer
Private IsChapitre As Boolean
 
'Les variables à extraire dans une table
Private ChampEan As String
Private ChampIntituleCarac As String
Private ValeurCarac As String
Private ChampCompletCarac As String
Private NomImage As String
Private NomFichier As String
 
Implements IVBSAXContentHandler
Implements IVBSAXErrorHandler
 
Private Sub IVBSAXContentHandler_characters( _
    strChars As String)
 
    If IsEan Then
    ChampEan = strChars
    ElseIf IsValueCarac Then
    'ValeurCarac = ValeurCarac & "|" & strChars
    ChampCompletCarac = ChampCompletCarac & " : " & strChars & "</p>"
    ElseIf IsImage Then
    NomImage = strChars
    ElseIf IsFichier Then
    'Debug.Print "#####################"
    'Debug.Print strChars
    'NomFichier = NomFichier & "|" & strChars
        If strChars Like "*[.]pdf" Then
        NomFichier = NomFichier & "|" & strChars
        ElseIf strChars Like "*[.]jpg" Then
        NomImage = NomImage & "|" & strChars
        Else
        End If
    End If
 
End Sub
 
Private Property Set _
    IVBSAXContentHandler_documentLocator( _
    ByVal RHS As MSXML2.IVBSAXLocator)
End Property
 
Private Sub IVBSAXContentHandler_endDocument()
 
    'Debug.Print "End of the xml"
 
End Sub
 
Private Sub IVBSAXContentHandler_endPrefixMapping( _
    strPrefix As String)
End Sub
 
Private Sub IVBSAXContentHandler_ignorableWhitespace( _
    strChars As String)
End Sub
 
Private Sub IVBSAXContentHandler_processingInstruction( _
    strTarget As String, strData As String)
End Sub
 
Private Sub IVBSAXContentHandler_skippedEntity( _
    strName As String)
End Sub
 
Private Sub IVBSAXContentHandler_startDocument()
 
    'Debug.Print "*******************"
    'Debug.Print "Start of XML document"
    'IsStartElement = False
    'IsValueElement = False
    IsEan = False
    ChampEan = ""
    IsCarac = False
    IntCarac = -1
    LineIndex = 0
    NomFichier = ""
    NomImage = ""
 
End Sub
 
Private Sub IVBSAXContentHandler_startElement( _
    strNamespaceURI As String, _
    strLocalName As String, strQName As String, _
    ByVal oAttributes As MSXML2.IVBSAXAttributes)
 
    If strLocalName = "ean" Then
    ChampEan = ""
    IsEan = True
    'Extraction du code Ean.
    'Debug.Print "StartElement:" & " " & strLocalName & "|" & strNamespaceURI
 
    ElseIf strLocalName Like "c#" Or strLocalName Like "c##" Or strLocalName Like "c###" Then
    IsCarac = True
    IntCarac = IntCarac + 1
    'Recupération des intitulés des caractéristiques en français
    'ChampIntituleCarac = ChampIntituleCarac & "|" & oAttributes.getValueFromName("", "fr")
 
    ChampCompletCarac = ChampCompletCarac & "<p class=" & Chr(34) & "desclongb" & Chr(34) & ">" & oAttributes.getValueFromName("", "fr")
    ElseIf strLocalName Like "fr" And IsCarac = True Then
    IsValueCarac = True
 
    ElseIf strLocalName = "image" Then
    IsImage = True
 
    ElseIf strLocalName = "fichier" Then
    IsFichier = True
 
 
    End If
 
End Sub
 
Private Sub IVBSAXContentHandler_endElement( _
    strNamespaceURI As String, _
    strLocalName As String, strQName As String)
 
    If strLocalName = "ean" Then
    IsEan = False
    'Debug.Print "EndElement:" & " " & strLocalName & "|" & strNamespaceURI
    ElseIf strLocalName Like "c#" Or strLocalName Like "c##" Or strLocalName Like "c###" Then
    IsCarac = False
 
    ElseIf strLocalName = "chapitre" Then
    'Debug.Print strLocalName
    IsChapitre = False
    'Debug.Print IntCarac
    IntCarac = -1
 
    ElseIf strLocalName Like "fr" And IsCarac = True Then
    IsValueCarac = False
 
    ElseIf strLocalName = "image" Then
    IsImage = False
 
    ElseIf strLocalName = "fichier" Then
    IsFichier = False
 
    ElseIf strLocalName = "fichiers" Then
 
    ElseIf strLocalName = "produit" Then
    'RAZ des informations et écritures dans la table Access.
 
    Dim rst As dao.Recordset
    Dim lngNum As Long
 
    'Ouvrir la table en lecture/écriture
    Set rst = CurrentDb.OpenRecordset("tblDestination", dbOpenDynaset)
        If TestLogique(ChampEan, "tblDestination", "CodeEan") = False Then
        ' Créer un enregistrement dans la table
        rst.AddNew
        ' Alimenter les champs
        rst("CodeEan") = ChampEan
        rst("Caracteristiques") = ChampCompletCarac
        rst("NomFichier") = NomFichier
        rst("NomImage") = NomImage
        ' Valider
        rst.Update
        rst.Close
        Set rst = Nothing
        Else
        End If
    'Debug.Print ChampEan
    'Debug.Print ChampIntituleCarac
    'Debug.Print ValeurCarac
    'Debug.Print ChampCompletCarac
    'Debug.Print NomFichier
    'Debug.Print NomImage
        NomFichier = ""
        NomImage = ""
        ChampCompletCarac = ""
        CodeEan = ""
 
    End If
End Sub
 
Private Sub IVBSAXContentHandler_startPrefixMapping( _
    strPrefix As String, strURI As String)
End Sub
 
'GESTION DES ERREURS
Private Sub IVBSAXErrorHandler_error(ByVal oLocator As MSXML2.IVBSAXLocator, strErrorMessage As String, ByVal nErrorCode As Long)
 
End Sub
 
Private Sub IVBSAXErrorHandler_fatalError(ByVal oLocator As MSXML2.IVBSAXLocator, strErrorMessage As String, ByVal nErrorCode As Long)
 
End Sub
 
Private Sub IVBSAXErrorHandler_ignorableWarning(ByVal oLocator As MSXML2.IVBSAXLocator, strErrorMessage As String, ByVal nErrorCode As Long)
 
End Sub

26/07/2016, 16h05
benji971

Bon j'ai modifié le code source ci-dessus pour qu'il alimente ma table Access. sur 1 ou 4 enregistrement ça fonctionne mais si j'applique le traitement sur une moitié de fichier ou le fichier complet j'ai une erreur qui fait planter le parsing avec ce message :

"Erreur d'exécution : 3163"
"system error -2146825125"

Comment je peux analyser l'erreur ou passer outre ?

J'ai vérifié mon fichier xml avec xml validator buddy et le xml est "well-formed".
26/07/2016, 18h13
benji971

Avant qu'on s'embete à me répondre le problème du msg d'erreur est résolu. c'était lié au fait que je concaténais les noms des images dans un champ texte et la taille était >255 caractère:aie:

Pour conclure le fichier s'est importé correctement dans Access (avec 23000 références insérés.) sans plantages et relativement vite je trouve.
problème résolu donc!:lahola: