Import de données, arborescence

Bonjour à tous,

Je solicite votre aide pour ma deuxième macro que j'essaie de faire, je progresse dans la programmation mais pas tant que je voudrais !

Je travaille sur une macro qui extrait des données d’un gros XML (cf ci-joint).
Mon idée est de faire une liste avec les valeurs des HREF (exemple HREF="AFC00000766A0200") à l’interieur des GRAPHREF et d’afficher son arborescence (les title des PSL et DU INV et le code de la DU-SOL).
J’ai deux soucis actuellement :

-Ma boucle « DO WHILE » s’arrete à la seconde itération (1ere position=0, position_fin=0 et second position=qlq chose, position_fin=qlq chose…), pourquoi ?

-Comment on recupère l’arborescence ? J’ai trouvé dans ma recherche internet une ligne de code (Xpath : //*[starts-with(name(),'PSL')]) mais ça n’a pas l’air d’être ça.

Pour info la structure est divisée en different PSL et se termine par un seul DU-INV et un DU-SOL (la ou se trouve le ou les code(s) HREF ou pas) exemple :
PSL
> PSL
>> PSL
>>> PSL
>>>>DU-INV
>>>>> DU-SOL
> PSL
>> DU-INV
>>> DU-SOL
...

Mon debut de code :

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

Public mot As String Public nomFichier As String   Function opened_file() As String 'ouverture des fichiers excel opened_file_data = Application.GetOpenFilename() If opened_file_data = False Then MsgBox ("File not selected, the program is turning off.") End   Else opened_file = opened_file_data ' W:\bibi\hola.xlsx Open opened_file_data For Input As #1 '-------------------     End If End Function   Public Sub Search_titre() opened_file ' ------------------   chaineCherche = "HREF=""" 'chaineCherche = "TITLE>" p = 1 i = 1 position_avancement = 1 Do While Not EOF(1) Line Input #1, strline Sheets(2).Cells(1, i) = strline 'On récupère la position de départ de la chaine de texte position = InStr(position_avancement, strline, chaineCherche, vbTextCompare) position_fin = InStr(position + 1, strline, """>", vbTextCompare)   If (position > 0) Then ThisWorkbook.Activate Sheets(1).Cells(1, i) = Mid(strline, position + Len(chaineCherche), position_fin - position - Len(chaineCherche)) ' Xpath : //*[starts-with(name(),'PSL')] i = i + 1 position = position_fin End If MsgBox (position & position_fin) Loop 'Until EOF(1) Close #1 End Sub

---

Bonjour,

une autre approche en utilisant une librairie gérant les XML, voir VBA et développement Web …

Merci de ton aide, mais ca me genere de nouveaux soucis...
Le probleme est que mon fichier xml n est pas "propre", c est a dire que j ai des balises non ferme et dans lesquelles se cachent l information que je cherche. Comme <all> ou <fileref....> sans </all>...
Vous avez une idee pour le solutionner?

Il est vrai qu'il y a deux types de fichiers où l'on trouve de tout et souvent du n'importe quoi : les .csv & les .xml !

Commencer par exiger du créateur du xml de se sortir les doigts d'où je pense et de se mettre à bosser proprement ‼

Sinon la visualisation du fichier xml en pièce jointe dans le Bloc-notes est digne des années 70 : psychédélique ‼

Sinon te reste plus qu'à y trouver des repères (balises ouvrantes, non ?) et t'accrocher !

Ne pouvant pas agir sur la creation de l'xml ... j'opte pour la seconde solution, mon idée du départ.
Comme le code à recuperer est du type HREF="AFC00000766A0200"
Ma balise d'entrée est :HREF="
Ma balise de sortie est :"
Mais le probleme du code que j'ai fait est que seule le premier code est recuperé... comment pourrai-je avoir tout le listing de chacune de ces codes?

Bonjour,

Si cela peut vous aider, j'ai fait un code de nettoyage de votre fichier .XML pour le rendre plus descriptible

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

'### Constantes à adapter ### Const XML_SOURCE As String = "c:\envoi.xml" Const XML_RESULT As String = "c:\tempo_CleanXML.xml" '############################   Sub CleanXML() Dim FSO As Object 'Scripting.FileSystemObject Dim myStream As Object 'Scripting.TextStream Dim A$ Dim B$ Dim i& '--- Set FSO = CreateObject("Scripting.FileSystemObject") Set myStream = FSO.OpenTextFile(XML_SOURCE, 1) '1=ForReading A$ = myStream.ReadAll myStream.Close '--- Set myStream = FSO.CreateTextFile(XML_RESULT) Do i& = InStr(2, A$, "<") If i& = 0 Then Exit Do B$ = Mid(A$, 1, i& - 1) myStream.WriteLine B$ A$ = Mid(A$, i&) Loop If A$ <> "" Then myStream.WriteLine A$ myStream.Close '--- Set myStream = Nothing Set FSO = Nothing '--- MsgBox "Le fichier nettoyé est : " & XML_RESULT End Sub

---

Je te remercie beaucoup PMO2017. Même si les lignes de codes, n'arrangent pas mon xml comme il devrait (la structure est modifiée) , il m'a permis en revanche de découvrir des fonctions du "Scripting.FileSystemObject" qui m'aident grandement à lire tout mon fichier.
J'arrive du coup maintenant à faire une liste des images ! et pense enfin pouvoir finir ce programme...

J'aurai une petite question supplémentaire maintenant:
Pour connaitre la structure lors du parcours de mon fichier A$, y a-t-il la possibilité de savoir quel string apparait le premier?
Un genre de instr(1, A$, "PSL" or "HREF" or "DU-SOL" or "DU-INV")

Merci

Citation:

---

J'aurai une petite question supplémentaire maintenant:
Pour connaitre la structure lors du parcours de mon fichier A$, y a t' il la possibilité de savoir quel string apparait le premier?
Un genre de instr(1, A$, "PSL" or "HREF" or "DU-SOL" or "DU-INV")

---

Bonjour,

Je ne comprends pas quelle est la finalité à obtenir, je ne peux donc rien faire.
****
Cependant, vous pouvez faire la démarche suivante pour y voir plus clair.
1) faites une copie du fichier résutat obtenu (soit tempo_CleanXML.xml) et changez le suffixe .xml par .txt
2) montez le .txt dans Excel par menu Ouvrir, Type de fichiers "Fichiers texte", Assistant Importation de texte "Délimité" puis "Terminer"
3) le fichier est dans une feuille Excel et vous pouvez faire des recherches par Ctrl+F

Cette démarche peut-elle affiner votre question et soumettre plus explicitement ce que vous voulez obtenir ?
A plus.