Import de fichier XML dans un tableau (pas un sheet)

**Ghost0000** · 15/06/2017, 18h29

Bonjour à tous,

J'aimerai importer un fichier xml non pas dans une feuille (car le collage est long, et varie selon le volume de données) mais plutôt dans un tableau virtuel.

Voilà le code :

Code :

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

1
2
3
4
5
6
                            'Importe le fichier dans une nouvelle Feuille
                            ThisWorkbook.XmlImport _
                                Url:=répertoire & Fich, _
                                ImportMap:=Nothing, _
                                Overwrite:=True, _
                                Destination:=ThisWorkbook.Sheets(Fichier).Range("$A$1")

Ma Question : COMMENT FAIRE ?

En effet la "Destination" du fichier est ici un sheet !

J'aimerai mettre ces données dans mon tableau que j'ai défini comme ceci :

Code :

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

1
2
3
4
5
6
7
'Tableaux
Public TAB_Fichier()
'*********************************************
'Fichier
With ThisWorkbook.Sheets("Fichier")
    TAB_Fichier = .Range(.Cells(1, 1), .Cells(.Range("A65356").End(xlUp).Row, .Cells(1, 255).End(xlToLeft).Column)).Value
End With

Merci de votre aide !

Cdlt.

GK

**Al__22** · 16/06/2017, 09h33

Il faut bien envisager l'arborescence de ton XML avant...
Peux-tu poster un exemple de tes nœuds ?

Sinon en passant par un recordset
[EDIT] Comme proposé par dysorthographie juste en dessous

Invité · 16/06/2017, 10h30

Bonjour,

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
Sub test()
Dim Tableau
Set rs = LoadRsFromXML("C:\MyRepertoire\P.244531412D50.xml")
If Not rs.EOF Then
Tableau = rs.getrows
End If
rs.Close
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

**Ghost0000** · 19/06/2017, 09h38

Envoyé par dysorthographie

Bonjour,

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
Sub test()
Dim Tableau
Set rs = LoadRsFromXML("C:\MyRepertoire\P.244531412D50.xml")
If Not rs.EOF Then
Tableau = rs.getrows
End If
rs.Close
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

Je vais tester, je vous tiens au courant, merci pour ce code

**Ghost0000** · 19/06/2017, 12h18

Le code marche, cependant un petit problème, les données sont toutes collées au sein de la dernière colonne (et elles ne sont pas individualisées)

Une idée pour régler ce problème ? Je vais essayer de voir comment faire...

La preuve en image :
Nom : DATA.png
Affichages : 1040
Taille : 16,6 Ko

Nom : DATA.png
Affichages : 1040
Taille : 16,6 Ko

Invité · 19/06/2017, 12h47

donnes un fichier avec des données bidonnées!

un Xml en Ado peut être vue comme un base de données en fonction de l'arborescence! on retouve les information sous forme de recordset en cascade!

https://www.developpez.net/forums/d1...d/#post9350330

Code :

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

MsgBox rs("namespace").Value.fields("querySubject").Value.fields("queryItem").Value.fields("expression").Value.fields("refobj").Value 'les  fields sont des RecordSet!

dans ton cas!

Code :

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

 rs("TAB_F15FRM").Value.fields

**Ghost0000** · 19/06/2017, 15h43

Merci pour ta réponse, cependant, je ne comprends pas vraiment ce que tu me racontes ^^

En fait, dans chaque ligne de mon tableau virtuel, il y a des infos concaténés, il faudrait les dissocier en indiquant un séparateur, le code suivant : rs("TAB_F15FRM").Value.Fields, ne fonctionne pas car mon TAB est un tableau virtuel défini comme suit : Public TAB_DATA()...donc pas de ""

**patricktoulon** · 19/06/2017, 15h46

bonjour
donne ton fichier xml en bidonant les données confidentielles mais en respectant son architecture
on y verra plus clair

Invité · 19/06/2017, 15h51

Envoyé par Ghost0000

Merci pour ta réponse, cependant, je ne comprends pas vraiment ce que tu me racontes ^^

En fait, dans chaque ligne de mon tableau virtuel, il y a des infos concaténés, il faudrait les dissocier en indiquant un séparateur, le code suivant : rs("TAB_F15FRM").Value.Fields, ne fonctionne pas car mon TAB est un tableau virtuel défini comme suit : Public TAB_DATA()...donc pas de ""

c'est un peux plus complexe que cela c'est pour te donner plus d'explication que je te demande un fichier!

**Ghost0000** · 19/06/2017, 16h48

Ok donne moi quelques minutes

EDIT : voici le fichier modifié : 20170619_1206.zip

**Ghost0000** · 19/06/2017, 18h35

UP

Invité · 20/06/2017, 10h37

Bonjour,
t'imagine bien que c'est plus facile à dire qu'a faire d'ou le temps de réaction!

je ne sais pas si tu as l'habitude de faire des requêtes sur une base de données mais en générale on se soucie que d'une table!

Code :

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

select * from [table]

et on récupéré le résultat de la requête dans un recordset!

là on fait une requête sur un fichier XML qui dispose d'une arborescence! on ne fait plus une requête sur une table mais sur une base de données et chaque items peut déboucher sur une autre liste d'items!

en quelques sorte nous nous retrouvons avec des champs liés à une autre table!

Code :

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

1
2
3
4
5
6
7
8
<Table1>
    <champs1>va1</champs1>
    <champs2>cvl2</champs2>
    <Table2>
        <Rschamps1>val1</Rschamps1>
        <Rschamps2>val2</Rschamps2>
    </table2>
</Table1>

chaque table nous restitue les valeur quel contient sous forme de recordset!

Code :

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

1
2
3
4
5
6
7
8
<recorset1>
    <champs1>va1</champs1>
    <champs2>cvl2</champs2>
    <recorset2>
        <Rschamps1>val1</Rschamps1>
        <Rschamps2>val2</Rschamps2>
    </recorset2>
</recorset1>

il nous faut par conséquence retourner un tableau pour chaque niveau d'items!
Nom : Sans titre.png
Affichages : 1050
Taille : 7,2 Ko

Nom : Sans titre.png
Affichages : 1009
Taille : 13,5 Ko

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
Public Tableau()Sub test()
ReDim Tableau(0)
Set Rs = LoadRsFromXML(ThisWorkbook.Path & "\20170619_1206.xml")
 MoveNext Rs
Rs.Close
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 MoveNext(Rs)
Dim f As Integer
While Not Rs.EOF
    For f = 0 To Rs.fields.Count - 1
       If TypeName(Rs(f).Value) = "Recordset" Then MoveNext Rs(f).Value
    Next
    ReDim Preserve Tableau(UBound(Tableau) + 1)
     Tableau(UBound(Tableau)) = GerRos(Rs) 
Wend
End Sub
Function GerRos(Rs)
GerRos = Rs.getrows
End Function

**Ghost0000** · 20/06/2017, 15h17

Ahh je vois ! Merci pour ce code, il est très avancé !

Par contre, le tableau dispose de trop de niveaux (je présume qu'il y a un niveau par balise XML ?)

Mon idée est de stocker le fichier XML dans un seul tableau afin que je puisse effectué diverses opérations sur celui-ci :

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
'Fichier F10_FRM
Set DIC_C_F10FRM = CreateObject("Scripting.Dictionary")          '-----> Ici je réalise un DIC_C, un dictionnaire récupérant les en-têtes de colonnes
For j = 1 To UBound(TAB_F10FRM, 2)
    If Not DIC_C_F10FRM.exists(TAB_F10FRM(1, j)) Then
        DIC_C_F10FRM.Add TAB_F10FRM(1, j), j
    End If
Next j

'-----> Ici je réalise un autre dictionnaire pour la correspondance entre "ZP" et "Date"
Set DIC_SITES_F10FRM = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(TAB_F10FRM, 1)
    If Not DIC_SITES_F10FRM.exists(TAB_F10FRM(i, DIC_C_F10FRM("zp_site"))) And TAB_F10FRM(i, DIC_C_F10FRM("date")) <> "" Then
        DIC_SITES_F10FRM.Add TAB_F10FRM(i, DIC_C_F10FRM("zp_site")), VBA.Split(TAB_F10FRM(i, DIC_C_F10FRM("date")), "/")(0) & "." & VBA.Split(TAB_F10FRM(i, DIC_C_F10FRM("date")), "/")(1) & "." & VBA.Left(VBA.Split(TAB_F10FRM(i, DIC_C_F10FRM("date")), "/")(2), 4)
    Else
        If VBA.CDate(TAB_F10FRM(i, DIC_C_F10FRM("date"))) < VBA.DateSerial(VBA.Split(DIC_SITES_F10FRM(TAB_F10FRM(i, DIC_C_F10FRM("zp_site"))), ".")(2), VBA.Split(DIC_SITES_F10FRM(TAB_F10FRM(i, DIC_C_F10FRM("zp_site"))), ".")(1), VBA.Split(DIC_SITES_F10FRM(TAB_F10FRM(i, DIC_C_F10FRM("zp_site"))), ".")(0)) Then
            DIC_SITES_F10FRM(TAB_F10FRM(i, DIC_C_F10FRM("zp_site"))) = VBA.Split(TAB_F10FRM(i, DIC_C_F10FRM("date")), "/")(0) & "." & VBA.Split(TAB_F10FRM(i, DIC_C_F10FRM("date")), "/")(1) & "." & VBA.Left(VBA.Split(TAB_F10FRM(i, DIC_C_F10FRM("date")), "/")(2), 4)
        End If
    End If
Next i

Mon tableau doit-être de forme TAB(i,j).

Conclusion : Comment faire pour stocker dans un seul et même tableau ? --> Je suppose que je dois redéfinir la façon dont sont stockés les informations dans les balises

Merci de votre aide.

GK

Invité · 20/06/2017, 15h44

oui je comprends! effectivement on a un tableau pour chaque niveau de l'arborescente.

il est toujours possible de ne récupérer que certains niveau de l'arborescence!

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
Sub test()
Set Rs = LoadRsFromXML(ThisWorkbook.Path & "\20170619_1206.xml")
Debug.Print Rs.fields("REFs").Value.fields("REF").Value.fields(0).Value
With Rs.fields("REFs").Value.fields("REF").Value
    While Not .EOF                                      'on scan le Recordset
        For i = 0 To .fields.Count - 1
            If TypeName(.fields(i).Value) <> "Recordset" Then Debug.Print .fields(i).Value
        Next
        .MoveNext
    Wend
 End With
MoveNext Rs.fields("REFs").Value.fields("REF").Value
MoveNext Rs
Rs.Close
End Sub

en revanche l'application utilise Rs.getrows qui converti un recoredSet en tableau. vouloir toutes les informations dans un seule et même tableau reviendrait à scanner tous les enregistrement des différents niveau! je pense plus judicieux de faire un passe sur le niveaux utiles quitte à faire une deuxième passe pour regrouper dans un seule tableau!

si on repart de l'exemple du début!

Code :

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

1
2
3
4
5
6
7
8
9
10
Sub test()
Set Rs = LoadRsFromXML(ThisWorkbook.Path & "\20170619_1206.xml")
e = Rs.getrows
ReDim Tableau(UBound(e))
For i = 0 To UBound(e)
a = e(3, i)
 Tableau(i) = Split(e(3, i), Chr(32))
Next
Rs.Close
End Sub

**patricktoulon** · 21/06/2017, 10h54

Bonjour de toute Facon si la structure (arborescence n'est pas respectée dans la variable tableau je me demande bien comment va t il se débrouiller pour l'exploiter correctement

perso je la converti en html dans une variable object("htmlfile") et je l'exploite comme un document html je peut même la paster sur le sheets en respectant l'architecture

je dis ca moi c'est entre nous hein !!