Discussion :

[Jlooz]

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:



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

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

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 :

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

[pijaku]

Bonjour,

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

[patricktoulon]

un exemple simple de base pour lire ton xml

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

[Jlooz]

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 :

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

[patricktoulon]

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
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é!!!)