Import XML dans acces 2007

**franky21** · 02/07/2015, 00h30

Bonjour, je cherche désespérement à automatiser en VBA l'importation d'un fichier XML dans une table UNIQUE d'access 2007 (ce que ne me fait pas la fonction Application.ImportXML "C:\Temp\Mon_Fichier.XML", acStructureAndData ). Je pensais avoir la solution avec le post trouvé ici http://access.developpez.com/faq/?page=Fichier#lirexml mais en fait la fonction Load ne semble pas marcher (j'arrive à 'erreur de lecture') alors que j'ai bien ajouté les références Microsoft XML (version 2 et même 6). Je suis donc bloqué avant même de pouvoir lire le contenu du XML.

Voici mon code

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
Public Function fctLireXML(ByVal nomfichier As String)
Dim xmlDoc As DOMDocument
Dim root As IXMLDOMElement
Set xmlDoc = New DOMDocument
xmlDoc.async = False
If xmlDoc.Load("C:\chemin\fichier.xml") Then
MsgBox "Document chargé"
Else
MsgBox " Erreur de lecture"
Exit Function
End If
Set root = xmlDoc.documentElement
If Not root Is Nothing Then
Debug.Print root.BaseName
fctRetourNoeudXML (root)
End If
Debug.Print "Fin de procédure"
End Function

et voici un extrait du fichier 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
<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE message SYSTEM "result_20.dtd"> 
<message message_id="2" message_dt="06/30/2015 12:45:37.741 PM" message_type="Result" message_sub_type="New_Results" message_dtd_version_number="2.0">
<header>
<from_application_id>0e7c8223-93eb-4f0c-86bf-7d34af5cb84d</from_application_id>
<to_application_id>link20a2-1272-4cb9-8cc0-ab835ef19539</to_application_id>
</header>
<body>
<result requisition_number="" diagnostic_set_id="20150630_113226_2" instrument="Catalyst_One">
<run_dt>06/30/2015 11:46:01.857 AM</run_dt>
<client client_id="">
<first_name></first_name>
<last_name></last_name>
</client>
<patient patient_id="101999" patient_species="CANINE">
<patient_name>TEST</patient_name>
</patient>
<doctor>
<first_name></first_name>
<last_name></last_name>
</doctor>
<results>
<assay_result assay_name="GLU">
<result_value_uom_cd>g/L</result_value_uom_cd>
<result_value>0,45</result_value>
<assay_reference_range>
<critical_low>0.15</critical_low>
<low>0.70</low>
<high>1.43</high>
<critical_high>7.00</critical_high>
</assay_reference_range>
<result_qualifier>=</result_qualifier>
</assay_result>
</results>
</result>
</body>
</message>

N'étant pas informaticien j'espère que c'est tout bête et que quelqu'un pourra me débloquer de cette impasse.

**Malick** · 02/07/2015, 00h39

Merci de bien vouloir utiliser les balises code pour poster vos codes, cela faciliterait la lecture. Voir l'explication ici : Les balises code

**PipoWIL** · 02/07/2015, 09h42

Bonjour,

Microsoft Access n'est, en effet, pas un champion du XML. Comme tu l'as remarqué, ton Application.ImportXML "C:\Temp\Mon_Fichier.XML", acStructureAndData ) a l'avantage d'être simple mais le désavantage d'être très limité à des fichiers très très simples!
Tu es bien parti. En lisant le début de ton code, personnellement, je ne vois pas de problème. Ton

Code :

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

1
2
3
4
5
6
7
8
9
10
11
Public Function fctLireXML(ByVal nomfichier As String)
Dim xmlDoc As DOMDocument
Dim root As IXMLDOMElement
Set xmlDoc = New DOMDocument
xmlDoc.async = False
If xmlDoc.Load("C:\chemin\fichier.xml") Then
MsgBox "Document chargé"
Else
MsgBox " Erreur de lecture"
Exit Function
End If

devrait fonctionner.
Es-tu sûr de ton chemin C:\chemin\.... ?
Ton fichier XML est-il "well formed" c'est-à-dire a-t-il tous les attributs et la syntaxe d'un 'bon' fichier XML ?
As-tu un parseur XML (Altova XMLSPY / Stylusstudio / ...) cela permet de valider le fichier XML d'abord sur la syntaxe (well formed) et ensuite avec un schema (well formed and valid).

Voici une autre manière de charger ton fichier

Code :

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

1
2
3
4
5
6
7
8
9
Public Function fctLireXML()
Dim xmlDoc As DOMDocument
Dim root As IXMLDOMElement
Set xmlDoc = New DOMDocument
xmlDoc.async = False
xmlDoc.Load "C:\chemin\fichier.xml"
Debug.Print xmlDoc.XML
set xmlDoc = nothing
End Function

Cela te donnera dans la fenêtre immediate (CTRL - G ) tout ton fichier XML (en espérant qu'il nest pas trop long. La fenêtre immediate ne donne que 100 lignes).
Mon code ou le tien font la la même chose : charger le fichier. Ensuite il faudra aller voir à l'intérieur pour en extraire les éléments dont tu as besoin.

**PipoWIL** · 02/07/2015, 13h42

Bonjour,
En jettant un deuxième coup d'oeil à ton fichier XML, je vois qu'il fait appel à un DTD (Document Type Definition). Il est possible que ce soit cela que ton application.importXML n'aime pas.
Tu peux essayer avec ceci :

Code :

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

1
2
3
If Not xmlDoc.loadXML(strPathFile) Then  'strXMLFichier is the string with XML
    Err.Raise xmlDoc.parseError.errorCode, , xmlDoc.parseError.reason
End If

pour voir quel genre de message il te donne.

Ensuite, tu peux aussi essayer en supprimant/commentant cette référence au DTD.
Ouvre ton XML avec Notepad (Bloc-Note) et remplace ceci

Code :

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

<!DOCTYPE message SYSTEM "result_20.dtd">

par ceci

Code :

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

<!-- <!DOCTYPE message SYSTEM "result_20.dtd"> -->

puis essaye de nouveau d'importer ton fichier.

**franky21** · 02/07/2015, 19h10

Merci PipoWil, c'est la première fois que je pose une question ici, je ne suis pas déçu. : c'était bien cette petite ligne DOCTYPE qui empêchait acces d'ouvrir le fichier !
Bon je "n'ai plus qu'à" trouver un moyen d'éditer le fichier XML à partir d'access pour supprimer automatiquement cette ligne (je crois avoir déjà lu quelque chose sur l'édition de fichier texte).
Grace à toi j'ai quand même déjà bien avancé dans mon projet en extrayant une partie des données qui m'intéressait (avant de les mettre dans une table d'access) mais comme c'est la première fois que j'extraie des données XML (en dehors des rubans) je n'arrive pas à extraire l'attribut (je crois que c'est comme ça que ça s'appelle d'après mes lectures) patient_id de la balise patient.
Pourrais-tu m'éclairer (ou quelqu'un d'autre) sur la ligne de code qui ferait référence à cette donnée ?
Le fichier XML est le même que dans mon premier message, par contre je joins ci-dessous le nouveau code que j'ai fait évolué (avant d'inclure la création de la table access).

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
Public Function fctLireXML(ByVal nomfichier As String)
Dim xmlDoc As DOMDocument
Dim parent As IXMLDOMElement
Dim fils As IXMLDOMElement
Set xmlDoc = New DOMDocument
xmlDoc.async = False
If Not xmlDoc.Load("C:\chemin\fichier.xml") Then
    MsgBox "Erreur de lecture du fichier XML"
    Exit Function
End If
Set parent = xmlDoc.documentElement
Set fils = xmlDoc.documentElement
If Not parent Is Nothing Then
    'Extraction du code anl
    xmlDoc.getElementsByTagName ("patient")
    Debug.Print parent.getAttribute("patient_id") ' C'est pas ca ! ca retourne null !
 
    For Each parent In xmlDoc.getElementsByTagName("assay_result")
        For Each fils In parent.childNodes
            If fils.baseName = "result_value" Then
                Debug.Print parent.getAttribute("assay_name") & " : " & fils.text
            End If
        Next
    Next
End If
Set xmlDoc = Nothing
Set fils = Nothing
Set parent = Nothing
Debug.Print "Fin de procédure"
End Function

**franky21** · 05/07/2015, 09h18

Avec un peu de tatonnement, j'ai trouvé la solution pour n'extraire que les données qui m'intéressent dans l'arborescence XML. Je joins le code si ca peut aider un débutant comme moi (si un informaticien y voit des lourdeurs ou erreur qu'il le signale, mais en tout cas ça marche). Il ne me reste plus qu'à rentrer les données dans une table Access.

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
Public Function fctXML_Lire(ByVal nomfichier As String)
On Error GoTo erreur
 
Dim xmlDoc As DOMDocument
Dim parent As IXMLDOMElement
Dim fils As IXMLDOMElement
Dim ptfils As IXMLDOMElement
 
Set xmlDoc = New DOMDocument
xmlDoc.async = False
If Not xmlDoc.Load(nomfichier) Then
    MsgBox "Erreur de lecture du fichier XML"
    Exit Function
End If
 
Set parent = xmlDoc.documentElement
Set fils = xmlDoc.documentElement
Set ptfils = xmlDoc.documentElement
 
If Not parent Is Nothing Then
    'Extraction du code client
    For Each parent In xmlDoc.getElementsByTagName("client")
        codeclient = parent.getAttribute("client_id")
        For Each fils In parent.childNodes
            If fils.baseName = "first_name" Then Nom = fils.text
        Next
    Next
 
    For Each parent In xmlDoc.getElementsByTagName("patient")
        codeanl = parent.getAttribute("patient_id")
        For Each fils In parent.childNodes
            Appellation = fils.text
        Next
    Next
 
    For Each parent In xmlDoc.getElementsByTagName("assay_result")
        analyse = parent.getAttribute("assay_name")
            For Each fils In parent.childNodes
                Select Case fils.baseName
                    Case "result_value"
                        If IsNumeric(fils.text) Then Résultat = CDbl(fils.text) Else Résultat = Val(fils.text)
                    Case "assay_reference_range"
                        For Each ptfils In fils.childNodes
                            Select Case ptfils.baseName
                                Case "low"
                                    low = ptfils.text
                                Case "high"
                                    high = ptfils.text
                            End Select
                   Next
                        If Résultat >= Val(low) And Résultat <= Val(high) Then Normalité = True Else Normalité = False
                    Case "result_qualifier"
                        If fils.text <> "=" Then Commentaire = fils.text
                End Select
            Next
    Next
End If
 
sortie:
Set xmlDoc = Nothing
Set ptfils=nothing
Set fils = Nothing
Set parent = Nothing
Exit Function
 
erreur:
Select Case err.Number
    Case Else
        Call fctAutre_erreur
End Select
Resume Next

**PipoWIL** · 09/07/2015, 15h36

Salut,

Heureux que tu aies trouvé une solution.
Entretemps, voici une autre voie qui peut être exploitée:
Le message d'erreur que tu obtiens lorsque tu fais

Code :

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

Application.ImportXML "c:/temp/MonFichier.xml", acStructureAndData

est dû à la deuxième ligne de ton document XML.

Code :

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

<!DOCTYPE message SYSTEM "result_20.dtd">

Ton document fait reference à un DTD supposé être dans le même folder que ton fichier XML. Comme VBA ne trouve pas ce fichier DTD, il refuse l'import.
La première solution serait de demander à ton partenaire de te fournir ce DTD. Si ce n'est pas possible, une solution consiste à créer ce DTD de toute pièce. Si tu es un as du XML, cela ne te posera pas de problème. Si ce n'est pas le cas, il faudra ruser et un petit filou que je connais a déjà réussi à leurer VBA simplement un créant un fichier vide (avec Notepad) et en le nomant "result_20.dtd". VBA n'y a vu que du feu !

**franky21** · 16/07/2015, 22h22

Salut,
Je n'avais pas eu de message comme quoi tu m'avais répondu. Merci de ta réponse. Le problème c'est que je n'arrive pas à avoir les fichiers du fournisseur de mon matériel. Je suis donc parti sur la voie de supprimer la 2ème ligne qui pose problème : <!DOCTYPE message SYSTEM "result_20.dtd">

J'ai donc, après tatonnement, créé la fonction suivante :

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
Public Function fctFichier_ModifContenu(nomfichier)
On Error GoTo erreur
 
nvnomfichier = Left(nomfichier, Len(nomfichier) - 4) & "2.xml"
 
Dim FSO As New Scripting.FileSystemObject
Dim FichSrc As Scripting.TextStream
Dim FichDest As Scripting.TextStream
Dim result As String
Dim arrLines
Dim NbLgnTot
Set FichSrc = FSO.OpenTextFile(nomfichier, ForReading)
result = FichSrc.ReadAll
arrLines = Split(result, vbCrLf)
NbLgnTot = UBound(arrLines)
Set FichDest = FSO.CreateTextFile(nvnomfichier, ForWriting)
For i = 0 To NbLgnTot
    If i <> 1 Then FichDest.WriteLine arrLines(i)
Next
 
sortie:
FichSrc.Close
Set FichSrc = Nothing
FichDest.Close
Set FichDest = Nothing
Set FSO = Nothing
Exit Function
 
erreur:
Select Case err.Number
    Case 53: MsgBox "Le fichier est introuvable"
    Case Else: Call fctAutre_erreur
End Select
Resume sortie
end function

Ca marche mais je ne comprends pas pourquoi NbLgnTot est à 2 alors qu'il y a plein de lignes avec retour de chariot dans mon fichier xml !?????.

**PipoWIL** · 17/07/2015, 09h50

Bonjour,

Es-tu vraiment sûr que ton fichier XML a des retours de chariot ? cela dépend de l'application qui a créé le fichier XML et il n'est pas rare de ne pas avoir tous les retours de chariot.

Une autre manière de travailler en utilisant les propriétés textuelles du XML serait ceci :

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
Public Function fctFichier_ModifContenu_sans_DTD()
On Error GoTo erreur
 
 
 
'Dim FSO As New FileSystemObject
'Dim FichSrc As Scripting.TextStream
'Dim FichDest As Scripting.TextStream
 
Dim FSO As Object
Dim FichSrc As TextStream
 
Dim FichDest As TextStream
Dim result As String
Dim arrLines
Dim NbLgnTot
Dim nomfichier As String
Dim nvnomfichier As String
Dim nvLigne As String
Dim i As Integer
 
Set FSO = CreateObject("scripting.filesystemobject")
 
nomfichier = "C:\Temp\testxml.xml"
nvnomfichier = Left(nomfichier, Len(nomfichier) - 4) & "2.xml"
 
Set FichSrc = FSO.OpenTextFile(nomfichier, ForReading)
result = FichSrc.ReadAll
 
Set FichDest = FSO.CreateTextFile(nvnomfichier, ForWriting)
 
 
nvLigne = Replace(result, "<!DOCTYPE message SYSTEM ""result_20.dtd""> ", "")
FichDest.Write nvLigne
 
 
sortie:
FichSrc.Close
Set FichSrc = Nothing
FichDest.Close
Set FichDest = Nothing
Set FSO = Nothing
Exit Function
 
erreur:
Select Case Err.Number
    Case 53: MsgBox "Le fichier est introuvable"
    Case Else: MsgBox "Call fctAutre_erreur"
End Select
Resume sortie
End Function

où j'utilise un REPLACE() pour faire disparaître la ligne en question.

tant que je t'ai en ligne, puis-je poser une question ? J'ai l'habitude d'utiliser l'objet FSO d'une manière différente. Ton code ma donné une erreur. As-tu défini une référence ? Laquelle ?

**franky21** · 18/07/2015, 13h52

Bonjour PipoWil,
En effet mon code XML n'avait pas de retour chariot à chaque ligne, je l'ai ouvert sur un autre ordi dans une fenêtre IE et là je n'avait que 3 lignes contrairement à ce que je voyais dans un éditeur XML (du coup tout s'explique pour mon code !)
Merci pour l'astuce REPLACE c'est plus joli, j'achète !
Quant à la référence pour utiliser la fonction que j'ai créée je crois que c'est Microsoft Scripting Runtime. Si ce n'est pas çà redis le moi je te donnerais la liste des références que j'ai mis dans mon projet (la dernière en date était Microsoft XML).
Je ne désespère pas d'avoir des infos complémentaires pour mes fichiers XML de la part de mon fournisseur de matériel mais çà doit passer par un informaticien aux USA et il est en formation pdt une semaine !!
Bon WE à toi

Import XML dans acces 2007 [AC-2007]

Access

Discussions similaires

Partager

Partager