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

Version imprimable

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:

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:

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

16/06/2017, 09h33
Al__22

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 :mrgreen:

Bonjour,

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

Citation:

Envoyé par dysorthographie

Bonjour,

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
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 :)

19/06/2017, 12h18
Ghost0000

1 pièce(s) jointe(s)

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 :
Pièce jointe 286783
19/06/2017, 12h47
Invité

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:

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:

rs("TAB_F15FRM").Value.fields
19/06/2017, 15h43
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 ""
19/06/2017, 15h46
patricktoulon

re

bonjour
donne ton fichier xml en bidonant les données confidentielles mais en respectant son architecture
on y verra plus clair
19/06/2017, 15h51
Invité

Citation:

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!
19/06/2017, 16h48
Ghost0000

1 pièce(s) jointe(s)

Ok donne moi quelques minutes

EDIT : voici le fichier modifié : Pièce jointe 286916
19/06/2017, 18h35
Ghost0000

UP :)

2 pièce(s) jointe(s)

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:

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:

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:

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!
Pièce jointe 287115 Pièce jointe 287120

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

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:

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

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:

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:

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

21/06/2017, 10h54
patricktoulon

re

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 !!;)
21/06/2017, 11h19
Invité

Bonjour Patrick,
Quelle que soit la méthode il faut toujours parser un xml et donc bien connaître sa structure!
21/06/2017, 12h13
patricktoulon

re

bonjour robert
oui et surtout bien savoir comment et quelle structure de tableau(dimention) que l'on veut et cela n'est très claire chez lui