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
|
Private Sub Commande1_Click()
Dim doc As MSXML2.DOMDocument
Dim pere As MSXML2.IXMLDOMNode
Dim fils As MSXML2.IXMLDOMNode
Dim dt As DAO.Recordset
Set dt = CurrentDb.OpenRecordset("table2")
Set doc = New MSXML2.DOMDocument
doc.async = False
doc.Load ("c:\test01.xml")
' Parcours fichier par noeud service
' ATTENTION LES FICHIERS XML SONT SENSIBLES A LA CASSE
' DISTINCTION ENTRE MAJUSCULE ET MINUSCULE
For Each fils In doc.getElementsByTagName("SERVICE")
dt.AddNew
' PARCOURIR enfants du noeud SERVICE
Call ParcourirXML(fils, dt)
If Not fils.parentNode Is Nothing Then
Set pere = fils.parentNode
' PARCOURIR PARENT DU NOEUD SERVICE
Call ParcourirPere(pere, fils.nodeName, dt)
End If
dt.Update
Next
Set doc = Nothing
dt.Close
Set dt = Nothing
End Sub
Public Sub ParcourirXML(ByRef pere As MSXML2.IXMLDOMNode, ByRef dt As DAO.Recordset)
' PARCOURIR ENFANT DU NOEUD SERVICE
Dim fils As MSXML2.IXMLDOMNode
If pere.hasChildNodes Then
For Each fils In pere.childNodes
Call ParcourirXML(fils, dt)
Next
Else
If pere.nodeType = NODE_TEXT Then
Call CreationEnregistrement(dt, pere.parentNode.nodeName, pere.Text)
End If
End If
End Sub
Private Sub ParcourirPere(ByRef encours As MSXML2.IXMLDOMNode, ByVal nonTester As String, _
ByRef dt As DAO.Recordset)
' ON REMONTE DANS LA HIERARCHIE DES NOEUDS JUSQU'AU NOEUDS "CLIENT"
' Variable "nonTester" reprend le nom du noeud déjà parcouru de façon à ne pas
' reparcourir l'arborescence de ce noeud
Dim pere As MSXML2.IXMLDOMNode
Dim fils As MSXML2.IXMLDOMNode
If encours.hasChildNodes Then
For Each fils In encours.childNodes
If fils.nodeName <> nonTester Then
Call CreationEnregistrement(dt, fils.nodeName, fils.Text)
End If
Next
End If
If Not encours.parentNode Is Nothing Then
If encours.nodeName <> "CLIENT" Then
' REMONTE DANS L'ARBORESCENCE JUSQU'AU NOEUD "CLIENT" RENCONTRE
Set pere = encours.parentNode
Call ParcourirPere(pere, encours.nodeName, dt)
End If
End If
End Sub
Private Sub CreationEnregistrement(ByRef dt As DAO.Recordset, ByVal nomChamps As String, _
ByVal valeurChamps As String)
' on parcours la table RESULTAT et on teste la correspondance entre le nom du champs
' et le nom du noeuds
Dim champs As DAO.Field
For Each champs In dt.Fields
If champs.Name = nomChamps Then
champs.Value = valeurChamps
Exit For
End If
Next
End Sub |
Partager