Exploitation de fichier XML

Version imprimable

1 pièce(s) jointe(s)

Bonjour à tous,

Débutant en VBA, je me suis mis à la recherche de solutions pour ce problème:

Je cherche à obtenir un fichier Excel regroupant les entrées et sorties repérées par des caméras IP, les caméras produisent un fichier XML quotidiennement, qui est envoyé par mail et également en FTP sur un répertoire, je cherche dans un premier temps à faire l'historique, en récupérant tout les fichiers obtenu par mail, le répertoire n'étant en place que depuis peu.

Jusqu'ici tout va bien, j'ai réussi à trouver et modifier légèrement un script pour extraire les fichiers des pièces jointes Outlook et les placer tous dans un répertoire.

J'ai ensuite essayer de lancer un script, trouvé sur ce même forum pour parcourir tout les fichiers XML et les insérer tous dans une seule feuille Excel, mais le résultat n'est pas satisfaisant du tout:

Pièce jointe 374181

Ce que je souhaiterai réaliser :

Je souhaiterai pouvoir créer pour chaque fichier dans le répertoire une ligne avec plusieurs colonnes ( dans un fichier Excel ) : la date, le nom de la porte, les entrées et les sorties.

Pour référence voici un des fichiers XML produits :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 <?xml version="1.0"?> <Metrics SiteId="X" Sitename="X " DeviceId="Device ID" Devicename="Porte E" DivisionId="1"> [...] <ReportData Interval="1440"> <Report Date="2018-04-16"> <Object Id="0" DeviceId="Device ID" Devicename="Porte E" ObjectType="0" Name="PORTE E" ExternalId="1"> <Count StartTime="00:00:00" EndTime="00:00:00" UnixStartTime="1523829600" Enters="5" Exits="4" Status="4"/> </Object> </Report> </ReportData> </Metrics>
Je n'ai cependant aucune expérience et aucune idée concernant la manipulation de ce genre de fichier via VBA...

Pour le moment mon script se contente de regrouper tout les fichiers dans la première colonne d'une feuille de calcul, puis de les scinder suivant un séparateur donné:
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 Sub on_y_va() 'ouvre une boite de dialogue qui permet de sélectionner le dossier où se trouvent les fichiers Range("A1:F65536").ClearContents 'supprime tout ce qui est sur la feuille active Dim Repertoire As FileDialog, monRepertoire As String Set Repertoire = Application.FileDialog(msoFileDialogFolderPicker) Repertoire.Show If Repertoire.SelectedItems.Count > 0 Then monRepertoire = Repertoire.SelectedItems(1) aspirer monRepertoire Else MsgBox "Aucun Répertoire Sélectionné" End If End Sub Sub aspirer(ceRepertoire As String) 'importe tous les fichiers les uns à la suite des autres dans la première colonne Dim Fso, SourceFolder, SubFolder, fichier As Object Dim ws As Worksheet, wrecap As Worksheet Set Fso = CreateObject("Scripting.FileSystemObject") Set SourceFolder = Fso.GetFolder(ceRepertoire) ' boucle sur tous les fichiers du répertoire For Each fichier In SourceFolder.Files If Right(fichier.Name, 4) = ".xml" Then N = FreeFile Open fichier For Input As #N i = 0 k = Range("A65536").End(xlUp).Row Do While Not EOF(1) Line Input #N, contenu i = k Cells(i, 1).Value = contenu k = k + 1 Loop Close #N End If Next fichier bla End Sub Sub bla() ' scinde et réparti les données de la première colonne sur les colonnes suivantes à chaque espace Columns("A:A").Select Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _ Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _ :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _ Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1)), _ TrailingMinusNumbers:=True Cells.Select Selection.Replace What:=".", Replacement:=",", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False End Sub
Pour référence, je n'ai pas produit ce code, il est directement issue d'une autre discussion sur ce forum, mais étant donné qu'il me permet de réaliser une partie des opérations désirées, je m'en suis servi comme base, pour le moment, j'ai juste changé le type de fichier à parcourir.

je souhaiterai pouvoir , à la place de copier l'intégralité de chaque fichier, parcourir les fichiers XML, et n'extraire que les données dont j'ai besoin( porte, date, entrées, sorties), pour venir ensuite les inscrire dans une feuille, mais je bloque, sur la stratégie à adopter et le type de fonctions à utiliser...

Si certains d'entre vous sont aptes à me guider , je vous en serait bien reconnaissant !

En vous remerciant d'avance pour toute aide apportée,

Je vous souhaite une bonne journée !

Jean

30/04/2018, 09h05
pijaku

Bonjour,

Tu trouveras toutes les réponses dans cette contribution ainsi que dans le lien déposé dans la réponse de kiki29.

1 pièce(s) jointe(s)

un exemple simple de base pour lire ton xml

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Sub test()
    Dim objXML As Object, noeuds As Object
    Dim fichier As String, i As Long
    Set objXML = CreateObject("Msxml2.DOMDocument")
    objXML.async = True
    objXML.Load "C:\Users\polux\Desktop\test.xml"
    Set noeuds = objXML.getElementsByTagName("Report")    'on collectionne tout les balise "Report"elles contiennent la date et ses enfant et et petits enfants contiennent les données que tu veux 
    'Debug.Print noeuds(0).XML
    For i = 0 To noeuds.Length - 1
        mess = "******************************" & vbCrLf
        mess = mess & "premier ""Report"" " & vbCrLf
        mess = mess & "date récupérée = " & noeuds(i).getattribute("Date") & vbCrLf    'element"Report"
        mess = mess & "porte = " & noeuds(i).ChildNodes(0).getattribute("Devicename") & vbCrLf    'attribut ("Devicename") du premier enfant de Reportdonc ("Object")
        mess = mess & "entrées = " & noeuds(i).ChildNodes(0).ChildNodes(0).getattribute("Enters") & vbCrLf    'attribut("Enters") du  fils de l'element "object"
        mess = mess & "sorties = " & noeuds(i).ChildNodes(0).ChildNodes(0).getattribute("Exits") & vbCrLf    'attribut("Exits") du  fils de l'element "object"
    Next
    MsgBox mess
End Sub

je travaille en late binding ("createobject...."pas de reference a activer )
si tu decide de travailler avec les reference donc les nodeliste etc... tu devra a chaque nodes convertir en object pour recupérer les ATTRIBUTS
car en fait tes elements n'ont pas de texte ils n'ont que des attributs
;)

Pièce jointe 374213

Tout d'abord, merci à vous pour votre aiguillage et vos réponses, j'ai réussi à formuler ma solution que je partage si d'autres personnes ont un besoin similaire, je me suis permis d'introduire des parties du code de @patricktoulon avec ses commentaires.

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
Sub test()
    Dim objXML As Object, noeuds As Object
    Dim fichier As String, i As Long
    Dim y As Long
    Dim Fso, SourceFolder, SubFolder, counter As Object
    Dim Repertoire As FileDialog, monRepertoire As String
 
    Range("A1:F65536").ClearContents 'clear de la feuille excel
 
   'on selectionne un repertoire
    Set Repertoire = Application.FileDialog(msoFileDialogFolderPicker)
    Repertoire.Show
    If Repertoire.SelectedItems.Count > 0 Then
        monRepertoire = Repertoire.SelectedItems(1)
    Else
        MsgBox "Aucun RÃ©pertoire SÃ©lectionnÃ©"
    End If
    'on cree les colonnes
    y = 0
    Cells(1, 1).Value = "Date"
    Cells(1, 2).Value = "Porte"
    Cells(1, 3).Value = "Entrees"
    Cells(1, 4).Value = "Sorties"
    '
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set SourceFolder = Fso.GetFolder(monRepertoire)
    'on parcours les fichiers présents dans le répertoire (fichiers CountsX.xml)
    For Each counter In SourceFolder.Files
        fichier = "C:\MONREPERTOIRE\Counts" & y & ".xml" ' a remplir manuellement
        Set objXML = CreateObject("Msxml2.DOMDocument")
        objXML.async = True
        objXML.Load fichier
        Set noeuds = objXML.getElementsByTagName("Report")    'on collectionne tout les balise "Report"elles contiennent la date et ses enfant et et petits enfants contiennent les donnÃƒÂ©es que tu veux
 
            For i = 0 To noeuds.Length - 1
                   Cells(y + 2, 1).Value = noeuds(i).getattribute("Date") & vbCrLf  'element"Report"
                   Cells(y + 2, 2).Value = noeuds(i).ChildNodes(0).getattribute("Devicename") & vbCrLf 'attribut ("Devicename") du premier enfant de Reportdonc ("Object")
                   Cells(y + 2, 3).Value = noeuds(i).ChildNodes(0).ChildNodes(0).getattribute("Enters") & vbCrLf  'attribut("Enters") du  fils de l'element "object"
                   Cells(y + 2, 4).Value = noeuds(i).ChildNodes(0).ChildNodes(0).getattribute("Exits") & vbCrLf   'attribut("Exits") du  fils de l'element "object"
            Next
 
        y = y + 1
    Next
   ' MsgBox mess
End Sub

Ce code me permet donc, de sélectionner un dossier, de la parcourir et de récuperer les éléments Date, Porte, Entrée et Sorties de chaque fichier, dans une feuille Excel.
A noter que je n'ai pas réussi à procéder de façon automatique pour les chemins du répertoire et des fichiers ( l 29 )... mais en le remplissant manuellement, tout fonctionne.

Encore un grand merci pour votre aide!

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
Option Explicit
Sub test()
    Dim dialogue, Dossier As String, fichier As String, x As Long, i As Long, objXML As Object, noeuds As Object
    With ActiveSheet
        .Range("A1", Cells(Rows.Count, 1).End(xlUp)).ClearContents    'clear de la feuille excel(rien que les cellules utilisées)
        Cells(1, 1).Resize(1, 4) = Array("Date", "Porte", "Entrees", "Sorties")    ' entetes de colonnes
 
        Set dialogue = Application.FileDialog(msoFileDialogFolderPicker)    'creation boite de dialogue folder
        If dialogue.Show <> -1 Then Exit Sub Else Dossier = dialogue.SelectedItems(1)    'sortie si annuler ou dossier devient le dossier parent
        'c'est parti en boucle sur dir
        fichier = Dir(Dossier & "\*.xml", vbNormal Or vbHidden Or vbSystem Or vbReadOnly)  'boucle dir sur ce dossier en prenant tout les xml
        x = 1
        Do
            x = x + 1
            Set objXML = CreateObject("Msxml2.DOMDocument")
            objXML.async = True: objXML.Load Dossier & "\" & fichier
            Set noeuds = objXML.getElementsByTagName("Report")    'on collectionne tout les balise "Report"elles contiennent la date et ses enfant et et petits enfants contiennent les donnÃƒÂ©es que tu veux
            For i = 0 To noeuds.Length - 1
                .Cells(x, 1).Value = noeuds(i).getattribute("Date")   'element"Report"
                .Cells(x, 2).Value = noeuds(i).ChildNodes(0).getattribute("Devicename")    'attribut ("Devicename") du premier enfant de Report donc ("Object")
                .Cells(x, 3).Value = noeuds(i).ChildNodes(0).ChildNodes(0).getattribute("Enters")   'attribut("Enters") du  fils de l'element "object"
                .Cells(x, 4).Value = noeuds(i).ChildNodes(0).ChildNodes(0).getattribute("Exits")    'attribut("Exits") du  fils de l'element "object"
            Next
            fichier = Dir
        Loop While fichier <> ""
    End With
End Sub

ca m'etonnerait pas que se soit plus rapide (FSO qu'en cas d'absolue necessité!!!);)