Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2016 Recuperer les données de fichier xml dans une feuile excel

BIL boud

XLDnaute Occasionnel
Bonjour


je souhaite recuperer des données a partir d'un xml et les stoker sur une feuile excel

j'ai trouve ce code mais je ne sais pas comment ca marche

VB:
Dim wks As Worksheet

Private Sub BrowseChildNodes(root_node As IXMLDOMNode)
Dim i As Long
Dim c As Long
Dim rng As Range

For i = 0 To root_node.ChildNodes.Length - 1
If root_node.ChildNodes.Item(i).NodeType <> 3 Then
If wks.UsedRange.Cells.Count = 1 Then
Set rng = wks.Cells(1)
Else
Set rng = wks.Cells(wks.UsedRange.Rows.Count + 1, 1)
End If
With rng
.Value = root_node.ChildNodes.Item(i).BaseName
.Offset(0, 1).Value = root_node.ChildNodes.Item(i).nodeTypeString
.Offset(0, 2).Value = root_node.ChildNodes.Item(i).NodeValue
.Offset(0, 3).Value = root_node.ChildNodes.Item(i).Node
For c = 0 To root_node.ChildNodes.Item(i).Attributes.Length - 1
.Offset(0, c + 4).Value = root_node.ChildNodes.Item(i).Attributes.Item(c).BaseName
.Offset(0, c + 5).Value = root_node.ChildNodes.Item(i).Attributes.Item(c).NodeValue
Next c
End With
End If
BrowseChildNodes root_node.ChildNodes(i)
Next
End Sub

Private Sub BrowseXMLDocument(ByVal filename As String)
Dim xmlDoc As DOMDocument, root As IXMLDOMElement
Dim i As Long
Dim c As Long

Set xmlDoc = New DOMDocument
xmlDoc.async = False
xmlDoc.Load filename
Set root = xmlDoc.DocumentElement
If Not root Is Nothing Then
If wks.UsedRange.Cells.Count = 1 Then
Set rng = wks.Cells(1)
Else
Set rng = wks.Cells(wks.UsedRange.Rows.Count + 1, 1)
End If
With rng
.Value = root.BaseName
.Offset(0, 1).Value = root.nodeTypeString
.Offset(0, 2).Value = root.NodeValue
.Offset(0, 3).Value = root.Text
For c = 0 To root.Attributes.Length - 1
.Offset(0, c + 4).Value = root.Attributes.Item(c).BaseName
.Offset(0, c + 5).Value = root.Attributes.Item(c).NodeValue
Next c
End With
BrowseChildNodes root
End If
wks.Cells(1).EntireRow.Insert xlShiftDown
With wks.Cells(1)
.Value = "baseName"
.Offset(0, 1).Value = "nodeTypeString"
.Offset(0, 2).Value = "nodeValue"
.Offset(0, 3).Value = "text"
c = 1
For i = 4 To wks.UsedRange.Columns.Count - 1 Step 2
.Offset(0, i).Value = "attribute" & c
.Offset(0, i + 1).Value = "Value" & c
c = c + 1
Next i
End With
wks.Rows(1).Font.Bold = True
End Sub

Sub test()
Set wks = Worksheets("Feuil28")
BrowseXMLDocument "C:\Desktop\XML\211_DW10F-TTAP_EURO6.3_20200130_HH_V7_BROUILLON.XML"
End Sub


est il possible de recuperer des données que moi je specifie ?


qlq un peut il maider SVP ?

Merci pour votre aide
 
Solution
Bonjour,
pour Windows
VB:
Private Sub test()
For i = 1 To Sheets.Count
    Sheets(i).Cells.Clear
Next
Set Rs = LoadRsFromXML("C:\MyRep\test.xml")
If TypeName(Rs) <> "Nothing" Then RecordsetRange Rs, 1 Else MsgBox "Err"
End Sub

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...

laurent3372

XLDnaute Impliqué
Il faut que tu écrives une macro qui contient le code suivant
VB:
BrowseXMLDocument "C:\Example\monDocument.xml"
En spécifiant le bon nom de fichier.
Cela remplira la feuille active avec le décodage du fichier XML.
 

BIL boud

XLDnaute Occasionnel
bonjour

merci pour ton retour,

oui ca je l'ai fait :
VB:
Sub test()
Set wks = Worksheets("Feuil28")
BrowseXMLDocument "C:\Desktop\XML\211_DW10F-TTAP_EURO6.3_20200130_HH_V7_BROUILLON.XML"
End Sub

c juste que je ne comprend pas le fonctionnement des instructions, merci encore pour ton aide
 

BIL boud

XLDnaute Occasionnel

Re

j'ai regardé le lien, le probleme est quil explique pas comment le faire par une macro (code)

j'ai mis code simple et j'ai compris comment ca fonctionne un petit peu :
VB:
Sub test_xml()

Dim fd As Office.FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)

With fd
       .Filters.Clear
       .Title = "select a XML File"
       .Filters.Add "XML File", "*.xml", 1
       .AllowMultiSelect = False
      
      
    If .Show = True Then
    xmlFileName = .SelectedItems(1)
    
    
    Dim xDoc As Object
    Set xDoc = CreateObject("MSXML2.DOMDocument")
    xDoc.async = False: xDoc.validateOnParse = False
    xDoc.Load (xmlFileName)
    
    
    
    Set Productss = xDoc.DocumentElement
    i = 2
    For Each Products In Productss.ChildNodes
    For Each Product In Products.ChildNodes
    Debug.Print "id: " & Product.ChildNodes(0).Text
    Debug.Print "name: " & Product.ChildNodes(1).Text
    Debug.Print "price: " & Product.ChildNodes(2).Text
    Debug.Print "quantity: " & Product.ChildNodes(3).Text
    Debug.Print "------------------------------------"
    
    
    Application.Cells(i, 5).Value = Product.ChildNodes(0).Text
    Application.Cells(i, 6).Value = Product.ChildNodes(1).Text
    Application.Cells(i, 7).Value = Product.ChildNodes(2).Text
    Application.Cells(i, 8).Value = Product.ChildNodes(3).Text
    '.Range("range")
    
     i = i + 1
    
    Next Product
    Next Products
    End If
    
End With

End Sub

le code fonctionne super bien,
y a t il un moyen de ne pas preciser les noms de balises (Products,Productss,Product)afin de recuperer exactement les mm données sur un autre fichier qui n'as pas forcement les mm nom de ces balises (mais contient les données recuperes (id,name,price,quantity) ?

je joint le fichier XML sur lequel jai recuperer ses données :

XML:
<?xml version="1.0" encoding="UTF-8"?>
<Productss>
<Products>
     <Product>
        <id>p01</id>
        <name>name 1</name>
        <price>5</price>
        <quantity>777</quantity>
    </Product>
    
    <Product>
        <id>p02</id>
        <name>name 2</name>
        <price>8</price>
        <quantity>778</quantity>       
    </Product>
    
    <Product>
        <id>p03</id>
        <name>name 3</name>
        <price>11</price>
        <quantity>779</quantity>
    </Product>
</Products>
</Productss>


merci d'avance
 

Hasco

XLDnaute Barbatruc
Repose en paix
Bonjour,

Productss, Products et Product sont des noms de variables il peuvent être remplacés par n'importe quel nom que vous pouvez imaginer. Ils ne correspondent pas forcement au noms de balises. La seule chose importante est de respecter la hiérarchie du document.

Mais voici un exemple avec PowerQuery et votre fichier products.xml.
Sélectionnez une cellule du tableau.
Dans l'éditeur de requête sélectionnez la première étape (Source) pour y changer le nom et le chemin du fichier

Cordialement
 

Pièces jointes

  • PQ-Xml document.xlsx
    16.7 KB · Affichages: 10

BIL boud

XLDnaute Occasionnel
merci pour ta reponse, mais je veux faire lextraction par un code vba et non excel
 

Hasco

XLDnaute Barbatruc
Repose en paix
Re,

Eh bien la première partie de ma réponse reste valable:

Productss, Products et Product sont des noms de variables il peuvent être remplacés par n'importe quel nom que vous pouvez imaginer. Ils ne correspondent pas forcement au noms de balises. La seule chose importante est de respecter la hiérarchie du document.
 

BIL boud

XLDnaute Occasionnel
RE
Si j'ai bien compris, a chaque fois je dois adapter le code par raport a la hierarchie du document (chqnger les variables ) ?

merci
 

Hasco

XLDnaute Barbatruc
Repose en paix
Re,

Non! Que votre variable 'Productss' s'appelle 'TrucMuch' ou 'Bidule', votre macro si elle respecte la hierarchie du fichier xml fonctionnera.

Dans votre macro la variable Nommée 'Productss' correspond à l'élément racine de la hierarchie.
souvent, cet élément racine est référencé par une variable nommée 'Root' dans beaucoup de programmes. Mais que cette variable s'appelle Root ou Productss n'a aucune espèce d'importance, c'est ce qu'elle désigne qui importe.

Faites la différence entre le contenant (variable) et le contenu (données).

Cordialement
 

dysorthographie

XLDnaute Accro
Bonjour,
pour Windows
VB:
Private Sub test()
For i = 1 To Sheets.Count
    Sheets(i).Cells.Clear
Next
Set Rs = LoadRsFromXML("C:\MyRep\test.xml")
If TypeName(Rs) <> "Nothing" Then RecordsetRange Rs, 1 Else MsgBox "Err"
End Sub

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 RecordsetRange(ByVal Rs As Object, ByRef IndexWs As Long)
Dim Ish As Long
Ish = IndexWs
If ThisWorkbook.Sheets.Count < IndexWs Then ThisWorkbook.Sheets.Add after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
With ThisWorkbook.Sheets(Ish)
For i = Rs.Fields.Count - 1 To 0 Step -1
    .Range("A1").Offset(0, i) = Rs.Fields(i).Name
  If TypeName(Rs.Fields(i).Value) = "Recordset" Then
  IndexWs = IndexWs + 1: RecordsetRange Rs.Fields(i).Value, IndexWs
  End If
Next
.Cells(.Cells.Rows.Count, "A").End(xlUp).Offset(1).CopyFromRecordset Rs
End With
End Sub
 
Dernière édition:

BIL boud

XLDnaute Occasionnel
Bonjour

ok, je commence a comprendre le pricipe

merci bcp
 

BIL boud

XLDnaute Occasionnel
bonjour

merci bcp pour ta reponse
 

Discussions similaires

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…