VBA - Lire & Récupérer données XML > Excel

Version imprimable

Bonjour,

Je voudrais récupérer des données d'un fichier XML dans Excel.

Fragment du fichier XML :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 <DC Bloum="29/10/2006" Blam="29/11/2006" Blim="29/11/2006"> <Database Name="BA"> <Table Name="BB" /> <Table Name="BC"> <Row Id="Valeur1"> <Column Name="Code" Value="Valeur1" /> <Column Name="Libelle" Value="Valeur2" /> <Column Name="Valeur" Value="Valeur3" /> ... ...
Pour l'instant je n'ai qu'un code qui ouvre et récupère le nom de chaque élément (DC, Datatbase, Table, Table...) or je souhaiterais pouvoir récupérer "BB", "29/11/2006" ou "Valeur2", par exemple.

Merci de votre aide (un tt petit bout de code suffira pour que je comprenne le mécanisme.)

salut,
si tu as déjà récupérer sous forme de chaine de caractère ton XML, regarde ce que ceci peut te donner

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Function RecupererTexteEntreBornes(texte As String, textedebut As String, textefin As String) As String
Dim result As String
Dim debut As Integer
Dim fin As Integer
    debut = InStr(1, texte, textedebut)
    fin = InStr(debut+len(textedebut), texte, textefin)
    result = ""
    If debut > 0 Then
        If fin > debut + Len(textedebut) Then
            result = Mid(texte, debut + Len(textedebut), fin - debut - Len(textedebut))
        Else
            result = Right(texte, Len(texte) - debut - Len(textedebut) + 1)
        End If
    End If
    RecupererTexteEntreBornes = result
End Function
sub test()
msgbox RecupererTexteEntreBornes(chaineXML,"Table Name=","/>")
end sub

28/12/2007, 17h58
House MD

Salut JpCheck,

Merci pour ta réponse.
Le truc c'est que comme le fichier est gigantesque, j'aimerai autant utiliser les fonction de parsing de la bibliothèque XML...

Aujourd'hui, j'utilise la méthode :

http://vb.developpez.com/faq/?page=Routines#lirexml

et j'aimerais autant continuer de cette manière.

Encore merci.

Voici une petite modification de la méthode que tu utilises. Elle remplit un feuille avec les informations sur chaque Node.

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
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).Text
                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("Feuil1")
    BrowseXMLDocument "C:\Documents and Settings\Jonathan\My Documents\Sylvain\Téléchargements\CommentKahuna\Video\commentkahuna\ProductionInfo.xml"
End Sub

31/12/2007, 10h37
House MD

Parfait.

C'est exactement ce que je cherchais.
Merci beaucoup à Singular mais également à JpCheck.