Decouper une fichier XML trop gros par macro VBA

Version imprimable

15/11/2017, 14h44
Nico6132P

Decouper une fichier XML trop gros par macro VBA

Bonjour,

Tout en étant relativement néophyte en VBA, je me suis lancé dans l'écriture d'une macro sur Excel qui me permet d'ouvrir un fichier XML de 4 millions de lignes pour finir avec un requeteur somme toute simple sur Excel.

Là où je bloque (le reste fonctionne), c'est le découpage automatisé du fichier source xml en 4 sous fichiers xml que je pourrais ainsi ouvrir sous excel.
Je souhaite ainsi écrire une macro VBA sous Excel qui après avoir ouvert Notepad++, copie colle un nombre de ligne fixe (800 000 lignes par exemple) dans un nouveau fichier XML, que je renommerai "fichier_-_Xsur4.xml".

Au-delà du lancement de l'application par Shell("C:\Program Files\Notepad++\notepad++.exe") qui fonctionne, je n'arrive pas à utiliser la fonction Sendkeys qui me semblait être la plus adaptée pour me permettre de lancer les copier-coller qui vont bien.

Deux questions se posent donc :
- Sendkeys est-elle la bonne fonction,
- Si oui, quelqu'un saurait-il m'aiguiller dans le code à rédiger pour parvenir à écrire cette marcro (j'imagine basique) : copier X lignes, coller dans nouveau xml, et renommer ce nouveau fichier.

Merci par avance,
Nicolas
15/11/2017, 16h31
Menhir

Citation:

Envoyé par Nico6132P

Là où je bloque (le reste fonctionne), c'est le découpage automatisé du fichier source xml en 4 sous fichiers xml que je pourrais ainsi ouvrir sous excel.
Je souhaite ainsi écrire une macro VBA sous Excel qui après avoir ouvert Notepad++, copie colle un nombre de ligne fixe (800 000 lignes par exemple) dans un nouveau fichier XML, que je renommerai "fichier_-_Xsur4.xml".

Il serait plus judicieux de passer par un traitement de fichier séquentiel.

Tu ouvres ton fichier source en lecture avec Open et tu ouvres ton 1er fichier de destination en écriture.
https://msdn.microsoft.com/fr-fr/VBA...open-statement

Tu fais une boucle jusqu'au EOF du fichier source avec dedans un Input qui va lire dans le fichier source ligne par ligne et un Write qui écrira chaque ligne dans le fichier destination.
https://msdn.microsoft.com/fr-fr/VBA...inputstatement
https://msdn.microsoft.com/fr-fr/VBA...writestatement

Dans ta boucle, tu ajoutes une variable compteur que tu incrémentes à chaque ligne lu/écrite.
Quand ce compteur atteint le nombre de lignes que tu as fixé, tu fermes ton fichier destination, tu en ouvres un autre et tu remets ta variable compteur à 0.
15/11/2017, 17h22
Invité

Bonsoir,
Un fichier Xml c'est un fichier texte balisé! <xml></xml> il ne suffit pas de copier 800 000 lignes pour lui donner une structure valide!

Qu'est ce qui bloque dans Excel?
15/11/2017, 17h45
Menhir

Citation:

Envoyé par dysorthographie

Un fichier Xml c'est un fichier texte balisé! <xml></xml> il ne suffit pas de copier 800 000 lignes pour lui donner une structure valide!

Qu'est ce qui bloque dans Excel?

Je lance une supposition.
Vu qu'il a Excel 2010, je pense que le problème est qu'il est limité à 1 M de lignes par onglet et qu'il veut tronçonner son fichier (sans doute récupéré) pour pouvoir ouvrir chaque morceau dans Excel et y faire un traitement de récupération de données qu'il contient.

Cela dit, si mon hypothèse est juste, il serait plus efficace de faire directement le traitement (ou au moins un prétraitement) en VBA plutôt que d'utiliser VBA pour faire un simple tronçonnage en 4 fichiers texte.
15/11/2017, 19h45
patricktoulon

re

re
heu et pourquoi pas en DOM non?
car en dom 80000 lignes n'est pas un soucis
Robert je te laisse poursuivre ;)
15/11/2017, 21h11
Invité

Bonsoir Patrick,

Voilà ce que j'ai trouvé, je n'ai pas regarder! Mais pour une première approche faut voir!

https://www.developpez.net/forums/d4...l/#post2801802

Si le demandeur pouvait poster un bout de structure de son Xml, je regarderai avec ado comme dab!
https://www.developpez.net/forums/d1...g/#post8618505

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Sub test()
Dim Onodes,objXML
Set objXML = CreateObject("Msxml2.DOMDocument")
objXML.async = True
objXML.Load "C:\Users\polux\Desktop\exemple.xml"
For Each onode In objXML.DocumentElement.ChildNodes

Debug.Print onode.XML

'dans cet boucle  écrire avec open for append !!!!!! dans un fichier freefile le onode.xml en testant 
'pourquoi pas le len ou tout autre méthode qui consisterait a diviser le code proprement 
'la propriété .xml donne le onode en entier en xml y compris ses enfants 

Next
End Sub

16/11/2017, 10h37
Nico6132P

1 pièce(s) jointe(s)
Bonjour,

En ouvrant mon PC ce matin, je vois toutes vos contributions ! Merci beaucoup.

Ci-joint une version alléger à 99% du fichier XML source.

Pour revenir sur les pistes que avez proposées :
- Mehnir : je vais tester open et la boucle? Ca devrait m'aider à bien avancer.
Pour la question du nombre de ligne, j'en ai conscience et s'il faut passer pour 5 sous fichiers plutôt que 4, je m'adapterai ce n'est pas un problème.
- dysor : j'ai compris qu'un xml de 1000 lignes n'était pas juste 10 fichiers de 100 lignes, mais c là que mes compétences s'éteignent !

quand j'utilise Sendkeys, après avoir lancé Notepad++ et un nouveau fichier "Test", pour lui faire écrire un "A" par exemple rien se n'affiche sur Notepad++
Code:

1 2 3 4 Sub Test() Shell ("C:\Program Files\Notepad++\notepad++.exe D:\Bureau\Test.xml") SendKeys ("A"): End Sub
- Patrick : DOM ca fait référence à quoi ? Ca a l'air intéressant, mais je n'ai pas saisi..

Merci encore,

a regarder d eplus pres ton xml on voi que l'architecture est baser sur la balise "pdv" contenant la ville et les prix etc....

on va essayer de faire un truc simple
je te propose de coupé ton xml par ville dans des fichier text ca te dis allons y alors
on va créer a l'occasion un dossier sur le bureau qui sera nommé xmlcoupé par la macro
dans ce dossier on va sauver chaque ville dans un fichier nommé " pdv1","pdv2","pdv3",etc....

commence par mettre ton xml sur le bureau tout simplement
teste cela
et ouvre le dossier xmlcoupé qui c'est créé dynamiquement
et ouvre et regarde les pdv
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 Sub test() Dim Onodes, objXML, Onoeud Dim fichier As String, x As Integer, i As Long Set objXML = CreateObject("Msxml2.DOMDocument") objXML.async = True objXML.Load "C:\Users\polux\Desktop\00_- PrixCarburants_annuel_2016.xml" Set noeuds = objXML.getElementsByTagName("pdv") 'on collectionne tout les balise "pdv" MkDir (Environ("userprofile") & "\Desktop\xmlcoupé") For Each Onoeud In noeuds i = i + 1 entete = "<?xml version=""1.0"" encoding=""ISO-8859-1"" standalone=""true""?>" it = Onoeud.XML fichier = Environ("userprofile") & "\Desktop\xmlcoupé\pdv" & i & ".txt" x = FreeFile Open fichier For Output As #x Print #x, entete & vbCrLf & Replace(it, Chr(34), """""") Close #x Next End Sub
c'est quasi instantané

en ce qui concerne l'écriture dans le fichier on pourrait utiliser la même librairie que pour la lecture et écrire des vrai fichier XML valises et solide

robert a toi de prendre le relais ;) le domiste par excellence

voili voilou

Bonjour,

je te propose de prendre ton XML en l'état!

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
Private Sub test()
For i = 1 To Sheets.Count
    Sheets(i).Cells.Clear
Next
Set Rs = LoadRsFromXML("C:\MyRepertoire\00_- PrixCarburants_annuel_2016.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

re
je voyais plutôt un truc du genre
chaque feuille sa pompe

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
Sub test()
    Dim Onodes, objXML, Onoeud
    Dim fichier As String, x As Integer, i As Long
    Set objXML = CreateObject("Msxml2.DOMDocument")
    objXML.async = True
    objXML.Load "C:\Users\polux\Desktop\00_- PrixCarburants_annuel_2016.xml"
    Set noeuds = objXML.getElementsByTagName("pdv")    'on collectionne tout les balise "pdv"
    s = 0
    For Each Onoeud In noeuds
        s = s + 1: a = 0: se = 1
        If Sheets.Count < s Then Sheets.Add After:=Sheets(Sheets.Count)
        For Each onoeuds2 In Onoeud.ChildNodes
            Set obj = onoeuds2
            Select Case onoeuds2.tagname
            Case "adresse"
                Sheets(s).Cells(1, 1).Resize(1, 2) = Array("adresse", onoeuds2.Text)
            Case "ville"
                Sheets(s).Cells(2, 1).Resize(1, 2) = Array("ville", onoeuds2.Text)
            Case "ouverture"
                Sheets(s).Cells(3, 1).Resize(1, 2) = Array("ouverture", obj.getattribute("debut"))
                Sheets(s).Cells(4, 1).Resize(1, 2) = Array("fermeture", obj.getattribute("fin"))
            Case "services"
                Sheets(s).Cells(5, 1) = "services"
                For Each serv In onoeuds2.ChildNodes
                    se = se + 1
                    Sheets(s).Cells(5, se) = serv.Text
                Next
            End Select
        Next
        With Sheets(s).Cells(Rows.Count, 1).End(xlUp).Offset(2, 0).Resize(1, 4)
            .Value = Array("prix", "VALEUR", "MAJ", "NOM")
            .Interior.Color = &H80C0FF
        End With
        For Each onoeuds2 In Onoeud.ChildNodes
            Set obj = onoeuds2
            If onoeuds2.tagname = "prix" Then
                Set obj = onoeuds2
                lig = Sheets(s).Cells(Rows.Count, 1).End(xlUp).Row + 1
                Sheets(s).Cells(lig, 1) = "prix"
                Sheets(s).Cells(lig, 2) = obj.getattribute("valeur")
                Sheets(s).Cells(lig, 3) = obj.getattribute("maj")
                Sheets(s).Cells(lig, 4) = obj.getattribute("nom")
            End If
        Next
    Next
End Sub

17/11/2017, 17h51
Nico6132P

Bonsoir,

j'ai testé ta solution Patrick et elle marche très bien avec le fichier xml fourni en exemple.
Malheureusement comme je l'avais indiqué dans mon premier post le fichier source xml fait plus de 4 millions de lignes et là forcément ça coince, puisque cela amène à créer quelques 12 000 onglets... et Excel n'apprécie pas vraiment.

J'en reviens donc à mon idée initiale qui était de créer X fichiers xml, à partir du XML source.
En l’occurrence :
- le premier intègre les pdv depuis l'id 1 000 001 à 31 120 010
- le second du pdv 31 130 002 à ...
- et ainsi de suite.
En renommant le nouveau fichier xml : PrixCarburant_1surX.xml

C'est cet ID qui est ma clé de lecture générale pour le reste de mon exploitation des valeurs.

Le reste de ma procédure étant stable, bien qu'un peu lourde, cela me permettrait d'aller au bout de mon objectif.

dysor : désolé, mais je n'arrive pas à comprendre ton code et son objectif... trop chaud pour moi !

Bonne soirée,
Nicolas

Bonsoir,
Il faut voir un xml comme une base de données
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 <xml> <table1> <champ1>valeur</Champ1> <champ1>valeur</Champ1> <champ2>valeur</Champ2> <champ2>valeur</Champ2> </table1> <table1> <champ1>valeur</Champ1> <champ1>valeur</Champ1> <champ2>valeur</Champ2> <champ2>valeur</Champ2> </table1> <table2> <champ1>valeur</Champ1> <champ1>valeur</Champ1> <champ2>valeur</Champ2> <champ2>valeur</Champ2> </table2> </xml>
Ici l'idée est de faire un onglet par table ce qui revient a faire ce que tu veux faire!

17/11/2017, 18h59
patricktoulon

re

@robert
les tables pour lui sont les balises "pdv" et visiblement il en a plus que le max de sheets possibles

il suffit de reprendre mon code
et diviser le length des pdv par 10 ou 20 et transcrire non pas une mais plusieurs pompes sur le même sheets