Création Indicateur

Bsr à tous,

J'ai une macro à créer et je débute alors je demande de l'aide et un peu de méthode svp.

Au départ j'ai des fichiers.zip avec dans leurs noms des informations à intégrer dans un tableau excel.

expl O60P0160-2016_08_22_16_21_29-KO.zip ( O60P0160 est une ref, 2016_08_22_16_21_29 est la date et l'heure du test et Ko est le résultat du test réussi ou pas)

premier soucis ce .zip peut contenir plusieurs fichiers avec pour nom les mêmes infos que .zip à part le résultat du test (Ok ou KO) et du coup ressemble à ceci O60P0160-2016_08_22_16_21_29-EY.ecu

Dans un premier temps pouvez-vous me guider pour créer une macro qui ouvrirait chaque .zip ajouterait le résultat du test dans le nom des fichiers .ecu et rangerait les infos dans un tableau avec pour colonnes "ref" date et heure" résultat test""Nb d'itération"

Nb d'itération doit compter le nb de fois que la ref apparaît.

et mon deuxième soucis est que la macro, la même ou une autre (qu'en pensez-vous?) doit ouvrir les fichiers .ecu pour aller chercher des infos à l'intérieure. mais je n'en suis pas là

en attendant de vous lire. Merci bcp.

Bonjour à tous,

Mon pb ne vous inspire pas trop ... c'est ptêtre trop une usine à gaz que l'on me demande.

Je ne sais pas comment je pourrai partager le pb.

Si vous avez des idées je suis toujours preneuse.

Merci à vous quand même

Excellente journée

Bonjour,

ci-joint exemple de code pour dézipper vos fichiers

Sub Unzip()

    Dim FSO As Object
    Dim ShApp As Object
    Dim dossier As Object, fichier As Object
    Dim répertoire_zip As String, répertoire_unzip As Variant

    '// Assignation des répertoires
     répertoire_zip = "D:\Docs\zip"
    répertoire_unzip = "D:\Docs\unzip"

    '// Assignation Application Shell et Objet gestion de fichiers
     Set ShApp = CreateObject("Shell.Application")
    Set FSO = CreateObject("Scripting.FileSystemObject")

    '// Balayage des fichiers .zip se trouvant dans le répertoire et dézippage
     Set dossier = FSO.GetFolder(répertoire_zip)
    For Each fichier In dossier.Files
        If FSO.GetExtensionName(fichier.Path) = "zip" Then
            ShApp.Namespace(répertoire_unzip).CopyHere ShApp.Namespace(fichier.Path).items
        End If
    Next

End Sub

Formidable !! tt est dezippé... moi il m'en dezippé qu'un seul... c'est une histoire de boucle c'est ça ?

merci, merci (je verrai plus tard pour supprimer les fichiers .ZIP dans le dossier source)

maintenant, aprés avoir dezipper, les fichiers .xls et .xml ne sont pas utiles.

Comment les supprimer automatiquement ? et copier dans Excel les noms des fichiers .ecu restants (utiles) ?

Bonjour,

Pour supprimer les fichiers .xls et .xml dézippés, il suffit d'ajouter ce groupe d'instructions :

Sub Unzip()

    Dim FSO As Object
    Dim ShApp As Object
    Dim dossier As Object, fichier As Object
    Dim répertoire_zip As String, répertoire_unzip As Variant

    '// Assignation des répertoires
     répertoire_zip = "D:\Docs\zip"
    répertoire_unzip = "D:\Docs\unzip"

    '// Assignation Application Shell et Objet gestion de fichiers
     Set ShApp = CreateObject("Shell.Application")
    Set FSO = CreateObject("Scripting.FileSystemObject")

    '// Balayage des fichiers .zip se trouvant dans le répertoire et dézippage
     Set dossier = FSO.GetFolder(répertoire_zip)
    For Each fichier In dossier.Files
        If FSO.GetExtensionName(fichier.Path) = "zip" Then
            ShApp.Namespace(répertoire_unzip).CopyHere ShApp.Namespace(fichier.Path).items
        End If
    Next

    '// suppression des fichiers .xls et .xml se trouvant dans le répertoire de dézippage
     Set dossier = FSO.GetFolder(répertoire_unzip)
    For Each fichier In dossier.Files
        If FSO.GetExtensionName(fichier.Path) = "xls" _
        Or FSO.GetExtensionName(fichier.Path) = "xml" Then
            fichier.Delete
        End If
    Next

End Sub

Merci énormément Thev. ...

J arrive à faire copier grace a copy path les noms des fichiers .ecu mais ca ne colle pas sur la bonne ligne dans mon fichier excel.

Il y a peut être une fonction exprès grâce à VBA.

Merci encore et bonne soirée

si tu veux mettre les noms de fichiers .ecu par exemple en colonne A de la feuille active, il suffit d'ajouter ce groupe d'instructions

Sub Unzip()

    Dim FSO As Object
    Dim ShApp As Object
    Dim dossier As Object, fichier As Object
    Dim répertoire_zip As String, répertoire_unzip As Variant
    Dim CellVide As Range

    '// Assignation des répertoires
     répertoire_zip = "D:\Docs\zip"
    répertoire_unzip = "D:\Docs\unzip"

    '// Assignation Application Shell et Objet gestion de fichiers
     Set ShApp = CreateObject("Shell.Application")
    Set FSO = CreateObject("Scripting.FileSystemObject")

    '// Balayage des fichiers .zip se trouvant dans le répertoire et dézippage
     Set dossier = FSO.GetFolder(répertoire_zip)
    For Each fichier In dossier.Files
        If FSO.GetExtensionName(fichier.Path) = "zip" Then
            ShApp.Namespace(répertoire_unzip).CopyHere ShApp.Namespace(fichier.Path).items
        End If
    Next fichier

    '// suppression des fichiers .xls et .xml et copie des noms de fichier .ecu
     Set dossier = FSO.GetFolder(répertoire_unzip)
    For Each fichier In dossier.Files
        If FSO.GetExtensionName(fichier.Path) = "xls" _
        Or FSO.GetExtensionName(fichier.Path) = "xml" Then
            fichier.Delete
        End If
        If FSO.GetExtensionName(fichier.Path) = "ecu" Then
            Set CellVide = ActiveSheet.Columns("A").Find(Null)
            If CellVide Is Nothing Then Set CellVide = Range("A1")
            CellVide = fichier.Path
        End If
    Next fichier

End Sub

génial, gd merci Thev...

c'est presque fini il me reste 3 soucis.... comment récupérer une partie du nom du fichier .ecu

expl O60P0160-2016_08_22_16_21_29-EY.ecu pour l’insérer dans une cellule voisine.

expl ref Date Nb d'itération Test

O60P0160 2016_08_22_16_21_29 Nb d'itération doit compter le nb de fois que la ref apparaît OK

mon deuxième soucis est que la macro, doit ouvrir les fichiers .ecu pour aller chercher des infos à l'intérieure. un fichier .ecu s'ouvre avec notepad par expl.

et le troisième est que pour bien faire il faudrait pouvoir insérer le résultat du test OK ou KO dans le nom du fichier .ecu (O60P0160-2016_08_22_16_21_29-EY.ecu) de chaque zip correspondant avant de les extraire complètement

expl O60P0160-2016_08_22_16_21_29-OK.zip ( O60P0160 est une ref, 2016_08_22_16_21_29 est la date et l'heure du test et Ko est le résultat du test réussi ou pas) et le fichier .ecu sans le resultat du test (O60P0160-2016_08_22_16_21_29-EY.ecu.


génial, gd merci Thev...

c'est presque fini il me reste 3 soucis.... comment récupérer une partie du nom du fichier .ecu

expl O60P0160-2016_08_22_16_21_29-EY.ecu pour l’insérer dans une cellule voisine.

mise en colonne des info

ref / Date / Nb d'itération / Test

O60P0160 / 2016_08_22_16_21_29/ Nb d'itération doit compter le nb de fois que la ref apparaît / OK

mon deuxième soucis est que la macro, doit ouvrir les fichiers .ecu pour aller chercher des infos à l'intérieure. un fichier .ecu s'ouvre avec notepad par expl.

et le troisième est que pour bien faire il faudrait pouvoir insérer le résultat du test OK ou KO dans le nom du fichier .ecu (O60P0160-2016_08_22_16_21_29-EY.ecu) de chaque zip correspondant avant de les extraire complètement

expl O60P0160-2016_08_22_16_21_29-OK.zip ( O60P0160 est une ref, 2016_08_22_16_21_29 est la date et l'heure du test et Ko est le résultat du test réussi ou pas) et le fichier .ecu sans le resultat du test (O60P0160-2016_08_22_16_21_29-EY.ecu.

Merci encore bonne nuit

Bonsoir,

Pour la mise en colonne ses infos et lecture du fichier, essayer cette version de code

Sub Unzip()

    Dim FSO As Object, ShApp As Object, références As Object
    Dim dossier As Object, fichier As Object, fichier_texte As Object
    Dim répertoire_zip As String, répertoire_unzip As Variant
    Dim CellVide As Range
    Dim infos() As String, référence As String, test As String, contenu_fichier As String
    Dim nb_itération As Integer
    Dim date_i As Date

    '// Assignation des répertoires
     répertoire_zip = "D:\Docs\zip"
    répertoire_unzip = "D:\Docs\unzip"

    '// Assignation application Shell, objet gestion de fichiers et collection de type dictionnaire pour les références
     Set ShApp = CreateObject("Shell.Application")
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set références = CreateObject("Scripting.Dictionary")

    '// Balayage des fichiers .zip se trouvant dans le répertoire et dézippage
     Set dossier = FSO.GetFolder(répertoire_zip)
    For Each fichier In dossier.Files
        If FSO.GetExtensionName(fichier.Path) = "zip" Then
            ShApp.Namespace(répertoire_unzip).CopyHere ShApp.Namespace(fichier.Path).items
            infos = Split(fichier.Name, "-")
            référence = Replace(infos(0), "expl ", "")
            If Not références.Exists(référence) Then références.Add Key:=référence, Item:=0
            test = Replace(infos(2), ".zip", "")
            If test = "OK" Then références(référence) = références(référence) + 1
        End If
    Next fichier

    '// traitement des fichiers se trouvant dans le répertoire de dézippage
     Set dossier = FSO.GetFolder(répertoire_unzip)
    For Each fichier In dossier.Files
        '/suppression des fichiers .xls et .xml se trouvant dans le répertoire de dézippage
        If FSO.GetExtensionName(fichier.Path) = "xls" _
        Or FSO.GetExtensionName(fichier.Path) = "xml" Then
            fichier.Delete
        End If
        '/écriture des infos associées au fichiers .ecu dans la feuille active
         If FSO.GetExtensionName(fichier.Path) = "ecu" Then
            'recherche première cellule vide en colonne A de la feuille active
             Set CellVide = ActiveSheet.Columns("A").Find(Null)
            If CellVide Is Nothing Then Set CellVide = Range("A1")
            'récupération des infos associées au fichier .ecu
             infos = Split(fichier.Name, "-")
            référence = infos(0)
            nb_itération = références(référence)
            infos = Split(infos(1), "_")
            date_i = DateSerial(infos(0), infos(1), infos(2))
            'écriture des infos dans la feuille active
             CellVide = fichier.Name
            CellVide.Offset(, 1) = référence
            CellVide.Offset(, 2) = date_i
            CellVide.Offset(, 3) = nb_itération
            'lecture du fichier
             Set fichier_texte = FSO.OpenTextFile(fichier.Path, 1)   'ouverture en lecture seule
             CellVide.Offset(1) = fichier_texte.ReadAll              'lecture du contenu
             fichier_texte.Close                                     'fermeture
        End If
    Next fichier

End Sub

Bonsoir à tous, Bonsoir Thev,

J'ai un message erreur 53 "pb de répertoire".

à la ligne

'/écriture des infos associées au fichiers .ecu dans la feuille active

If FSO.GetExtensionName(fichier.Path) = "ecu" Then

les fichiers .xml et .xls ne sont pas supprimés

PI : répertoire_zip = "C:\Users\xxxxxx\Documents\Macro XXX\zip"

répertoire_unzip = "C:\Users\xxxxxx\Documents\Macro XXX\ecu"

Merci pour votre dévouement

Bonne soirée

Bonjour,

ci-dessous correction et ajout de vos répertoires

Sub Unzip()

    Dim WS As Object, FSO As Object, ShApp As Object, références As Object
    Dim dossier As Object, fichier As Object, fichier_texte As Object
    Dim répertoire_zip As String, répertoire_unzip As Variant
    Dim CellVide As Range
    Dim infos() As String, référence As String, test As String, contenu_fichier As String
    Dim nb_itération As Integer
    Dim date_i As Date

    '// Assignation des répertoires
     Set WS = CreateObject("WScript.Shell")
    répertoire_zip = WS.SpecialFolders("MyDocuments") & "\Macro XXX\zip"
    répertoire_unzip = WS.SpecialFolders("MyDocuments") & "\Macro XXX\ecu"

    '// Assignation application Shell, objet gestion de fichiers et collection de type dictionnaire pour les références
     Set ShApp = CreateObject("Shell.Application")
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set références = CreateObject("Scripting.Dictionary")

    '// Balayage des fichiers .zip se trouvant dans le répertoire et dézippage
     Set dossier = FSO.GetFolder(répertoire_zip)
    For Each fichier In dossier.Files
        If FSO.GetExtensionName(fichier.Path) = "zip" Then
            ShApp.Namespace(répertoire_unzip).CopyHere ShApp.Namespace(fichier.Path).items
            infos = Split(fichier.Name, "-")
            référence = Replace(infos(0), "expl ", "")
            If Not références.Exists(référence) Then références.Add Key:=référence, Item:=0
            test = Replace(infos(2), ".zip", "")
            If test = "OK" Then références(référence) = références(référence) + 1
        End If
    Next fichier

    '// traitement des fichiers se trouvant dans le répertoire de dézippage
     Set dossier = FSO.GetFolder(répertoire_unzip)
    For Each fichier In dossier.Files
        '/suppression des fichiers .xls et .xml se trouvant dans le répertoire de dézippage
         If FSO.GetExtensionName(fichier.Path) = "xls" _
        Or FSO.GetExtensionName(fichier.Path) = "xml" Then
            fichier.Delete
        Else
            '/écriture des infos associées au fichiers .ecu dans la feuille active
             If FSO.GetExtensionName(fichier.Path) = "ecu" Then
                'recherche première cellule vide en colonne A de la feuille active
                 Set CellVide = ActiveSheet.Columns("A").Find(Null)
                If CellVide Is Nothing Then Set CellVide = Range("A1")
                'récupération des infos associées au fichier .ecu
                 infos = Split(fichier.Name, "-")
                référence = infos(0)
                nb_itération = références(référence)
                infos = Split(infos(1), "_")
                date_i = DateSerial(infos(0), infos(1), infos(2))
                'écriture des infos dans la feuille active
                 CellVide = fichier.Name
                CellVide.Offset(, 1) = référence
                CellVide.Offset(, 2) = date_i
                CellVide.Offset(, 3) = nb_itération
                'lecture du fichier
                 Set fichier_texte = FSO.OpenTextFile(fichier.Path, 1)   'ouverture en lecture seule
                 CellVide.Offset(, 4) = fichier_texte.ReadAll              'lecture du contenu
                 fichier_texte.Close                                     'fermeture
            End If
        End If
    Next fichier

End Sub

Bonjour Thev,

vous êtes formidable, ça marche

Voici le contenu du fichier .ecu

Il me faudrait extraire seulement les Pref et à leur droite le détail des Pref

Resultats

Nome du fichierOX23454-2016_08_22_16_43_53-EF-1-1786032-10BLUE.ecu

Exécuté sans alarmes sans alerts

Depart des donneés

PX0YXZX RE Bla bla bla bla l csfsesdfdvdgdgfsdfd n°1 : level 2 monitoringujkgjghjhgj

bla bla bla l csfsesdfdvdgdgfsdfd n°1 : level 2 mon;PEEEEEEE DTC;Test failed since last clear;

00100111 Information

PVXYXZX Bla bla bla bla l csfsesdfdvdgdgfsdfd n°1 : level 2 monitoringujkgjghjhgj detection failure

bla bla bla l csfsesdfdvdgdgfsdfd n°1 : level 2 mon since last clear;

00101111 Information

Fin des donneés

Le Pref débute toujours au même niveau dans le fichier et commence toujours par P et contient 7 caractères, par contre dans l'exemple il y en a 2 mais cela peut varier, je ne connais pas le maximum.

Après ceci restera la récupération du résultat présent dans le nom du ZIP ( expl O60P0160-2016_08_22_16_21_29-OK.zip) mais malheureusement abst dans celui du .ecu.(O60P0160-2016_08_22_16_21_29-EY.ecu)

j'aurai besoin de méthode, ne serait-il pas judicieux d'extraire les zip dans un dossier du même nom et d'attribuer le résultat OK ou KO dans les fichiers dézippés respectifs.. et là plus que jamais j'ai vraiment besoin de votre talent. je recherche dans le forum tout ce qui concerne copie de chaine de caractères mais bon en tant que vraie débutante... je rame

Encore GD GD merci

Bon appétit

Bonsoir,

ci-jointe version pour écriture des préférences en supposant qu'elles commencent par "P" après un saut de ligne et se terminent par "Information".

L'attribution du résultat OK est stockée par référence dans la collection "références" lors du balayage des fichiers ZIP dans le répertoire macro xxx\zip. Ce résultat est ensuite attribué à chaque référence des fichiers ECU balayés dans le répertoire macro xxx\ecu.

Sub Unzip()

    Dim WS As Object, FSO As Object, ShApp As Object, références As Object
    Dim dossier As Object, fichier As Object, fichier_texte As Object
    Dim répertoire_zip As String, répertoire_unzip As Variant
    Dim CellVide As Range
    Dim infos() As String, référence As String, test As String, contenu_fichier As String
    Dim nb_itération As Integer, i As Integer
    Dim date_i As Date

    '// Assignation des répertoires
     Set WS = CreateObject("WScript.Shell")
    répertoire_zip = WS.SpecialFolders("MyDocuments") & "\Macro XXX\zip"
    répertoire_unzip = WS.SpecialFolders("MyDocuments") & "\Macro XXX\ecu"

    '// Assignation application Shell, objet gestion de fichiers et collection de type dictionnaire pour les références
     Set ShApp = CreateObject("Shell.Application")
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set références = CreateObject("Scripting.Dictionary")

    '// Balayage des fichiers .zip se trouvant dans le répertoire et dézippage
     Set dossier = FSO.GetFolder(répertoire_zip)
    For Each fichier In dossier.Files
        If FSO.GetExtensionName(fichier.Path) = "zip" Then
            ShApp.Namespace(répertoire_unzip).CopyHere ShApp.Namespace(fichier.Path).items
            infos = Split(fichier.Name, "-")
            référence = Replace(infos(0), "expl ", "")
            If Not références.Exists(référence) Then références.Add Key:=référence, Item:=0
            test = Replace(infos(2), ".zip", "")
            If test = "OK" Then références(référence) = références(référence) + 1
        End If
    Next fichier

    '// traitement des fichiers se trouvant dans le répertoire de dézippage
     Set dossier = FSO.GetFolder(répertoire_unzip)
    For Each fichier In dossier.Files
        '/suppression des fichiers .xls et .xml se trouvant dans le répertoire de dézippage
         If FSO.GetExtensionName(fichier.Path) = "xls" _
        Or FSO.GetExtensionName(fichier.Path) = "xml" Then
            fichier.Delete
        Else
            '/écriture des infos associées au fichiers .ecu dans la feuille active
             If FSO.GetExtensionName(fichier.Path) = "ecu" Then
                'recherche première cellule vide en colonne A de la feuille active
                 Set CellVide = ActiveSheet.Columns("A").Find(Null)
                If CellVide Is Nothing Then Set CellVide = Range("A1")
                'récupération des infos associées au fichier .ecu
                infos = Split(fichier.Name, "-")
                référence = infos(0)
                nb_itération = références(référence)
                infos = Split(infos(1), "_")
                date_i = DateSerial(infos(0), infos(1), infos(2))
                'écriture des infos dans la feuille active
                 CellVide = fichier.Name
                CellVide.Offset(, 1) = référence
                CellVide.Offset(, 2) = date_i
                CellVide.Offset(, 3) = nb_itération
                'lecture du fichier
                 Set fichier_texte = FSO.OpenTextFile(fichier.Path, 1)   'ouverture en lecture seule
                 contenu_fichier = fichier_texte.ReadAll                 'lecture du contenu
                 fichier_texte.Close                                     'fermeture
                'écriture préférences
                 infos = Split(contenu_fichier, Chr(10) & "P")
                For i = 1 To UBound(infos)
                    CellVide.Offset(, 3 + i) = "P" & Split(infos(i), "Information")(0) & " Information"
                Next i
            End If
        End If
    Next fichier

End Sub

Bsr Thev,

Encore merci tt fonctionne sauf la récupération des P références (et non préférences ) et leurs détails.

sinon j'ai su deplacé la récupération (ridicule pour vous j'imagine mais pour moi une petite victoire ) de la date (il faudrait l'affichage de l'heure aussi) et nombre itération (Compte le nombre de fois que le "N° moteur" apparait Fixe ne prend pas en compte l'ordre d'apparition).

voila à quoi doit ressembler le fichier indicateur demandé

Nom / Numéro / Réf Moteur / N° Moteur/ DATE ET HEURE/Nombre d'Iteration /Résultat /P réferénce / Détails

. ecu / OX23454 / 10BLUE / 1786032 / 2016_08_22_16_21_43 ....../1 ......................./OK........../PX0YXZX.../ RE Bla bla bla bla l csfsesdfdvdgdgfsdfd n°1 : level 2 monitoringujkgjghjhgj bla bla bla l .;csfsesdfdvdgdgfsdfd n°1 : level 2 mon;PEEEEEEE DTC;Test failed since last clear;00100111Information

je n'ai pas compris ceci, mais j'ai confiance

"L'attribution du résultat OK est stockée par référence dans la collection "références" lors du balayage des fichiers ZIP dans le répertoire macro xxx\zip. Ce résultat est ensuite attribué à chaque référence des fichiers ECU balayés dans le répertoire macro xxx\ecu."

Encore merci

Bonne soirée

ci-jointe nouvelle version

Sub Unzip()

    Dim WS As Object, FSO As Object, ShApp As Object, références As Object
    Dim dossier As Object, fichier As Object, fichier_texte As Object
    Dim répertoire_zip As String, répertoire_unzip As Variant
    Dim CellVide As Range
    Dim infos() As String, référence As String, P_référence As String, lib_P_réf As String, test As String, contenu_fichier As String
    Dim nb_itération As Integer, i As Integer
    Dim date_i As Date

    '// Assignation des répertoires
     Set WS = CreateObject("WScript.Shell")
    répertoire_zip = WS.SpecialFolders("MyDocuments") & "\Macro XXX\zip"
    répertoire_unzip = WS.SpecialFolders("MyDocuments") & "\Macro XXX\ecu"

    '// Assignation application Shell, objet gestion de fichiers et collection de type dictionnaire pour les références
     Set ShApp = CreateObject("Shell.Application")
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set références = CreateObject("Scripting.Dictionary")

    '// Balayage des fichiers .zip se trouvant dans le répertoire et dézippage
     Set dossier = FSO.GetFolder(répertoire_zip)
    For Each fichier In dossier.Files
        If FSO.GetExtensionName(fichier.Path) = "zip" Then
            ShApp.Namespace(répertoire_unzip).CopyHere ShApp.Namespace(fichier.Path).items
            infos = Split(fichier.Name, "-")
            référence = Replace(infos(0), "expl ", "")
            If Not références.Exists(référence) Then références.Add Key:=référence, Item:=0
            test = Replace(infos(2), ".zip", "")
            If test = "OK" Then références(référence) = références(référence) + 1
        End If
    Next fichier

    '// traitement des fichiers se trouvant dans le répertoire de dézippage
     Set dossier = FSO.GetFolder(répertoire_unzip)
    For Each fichier In dossier.Files
        '/suppression des fichiers .xls et .xml se trouvant dans le répertoire de dézippage
         If FSO.GetExtensionName(fichier.Path) = "xls" _
        Or FSO.GetExtensionName(fichier.Path) = "xml" Then
            fichier.Delete
        Else
            '/écriture des infos associées au fichiers .ecu dans la feuille active
             If FSO.GetExtensionName(fichier.Path) = "ecu" Then
                'recherche première cellule vide en colonne A de la feuille active
                 Set CellVide = ActiveSheet.Columns("A").Find(Null)
                If CellVide Is Nothing Then Set CellVide = Range("A1")
                'récupération des infos associées au fichier .ecu
                 infos = Split(Replace(fichier.Name, ".ecu", ""), "-")
                référence = infos(0)
                nb_itération = références(référence)
                'écriture des infos dans la feuille active
                 CellVide = fichier.Name
                CellVide.Offset(, 1) = référence
                CellVide.Offset(, 2) = infos(5)
                CellVide.Offset(, 3) = infos(4)
                CellVide.Offset(, 4) = infos(1)
                CellVide.Offset(, 5) = nb_itération
                If nb_itération < 0 Then CellVide.Offset(, 6) = "OK" Else CellVide.Offset(, 6) = "KO"
                'lecture du fichier
                 Set fichier_texte = FSO.OpenTextFile(fichier.Path, 1)   'ouverture en lecture seule
                 contenu_fichier = fichier_texte.ReadAll                 'lecture du contenu
                 fichier_texte.Close                                     'fermeture
                'écriture P_références
                 infos = Split(contenu_fichier, Chr(10) & "P")
                For i = 1 To UBound(infos)
                    P_référence = "P" & Left(infos(i), 7)
                    lib_P_réf = Right(infos(i), Len(infos(i)) - 7)
                    CellVide.Offset(, 5 + i * 2) = P_référence
                    CellVide.Offset(, 6 + i * 2) = Split(lib_P_réf, "Information")(0) & " Information"
                Next i
            End If
        End If
    Next fichier

End Sub

Bsr et Merci Thev,

tt fonctionne sauf la récupération des P référence et les Résultats ne sont pas justes puisque la macro ne remonte pas le résultat du Zip pére du fichier ecu (ds mes fichiers il y a des OK alors que s'affiche seulement KO)

A noter que l'affichage du N°moteur est une série de ##################### (avec comme message contextuel : "les dates et heures négatives s'affichent sous la forme #########")

Merci énormément pour votre boulot et votre patience

Oudot a écrit :

récupération des P référence

quel résultat obtenez-vous par rapport à celui à obtenir ?
Oudot a écrit :

la macro ne remonte pas le résultat du Zip pére du fichier ecu (ds mes fichiers il y a des OK alors que s'affiche seulement KO)

Communiquez-moi la liste des noms des fichiers ZIP et des fichiers ECU. Je suis basé sur votre explication :

expl O60P0160-2016_08_22_16_21_29-OK.zip ( O60P0160 est une ref, 2016_08_22_16_21_29 est la date et l'heure du test et Ko est le résultat du test réussi ou pas) et le fichier .ecu sans le resultat du test (O60P0160-2016_08_22_16_21_29-EY.ecu.

Je stocke par exemple pour la référence "O60P0160" le nombre de fichiers ZIP comportant "OK" et j'attribue ce nombre à chaque fichier ECU comportant cette référence "O60P0160".

Bonjour Thev,

quel résultat obtenez-vous par rapport à celui à obtenir ? aucun idem pour le détail (rien ne s'affiche)

Communiquez-moi la liste des noms des fichiers ZIP et des fichiers ECU. Je suis basé sur votre explication : cf PJ

Bon courage

Merci bcp

9macro.txt (882.00 Octets)

Bonjour,

ci-jointe correction pour le résultat OK. Pour le détail des P_références, communiquez-moi si posiible un des fichier ECU.

Sub Unzip()

    Dim WS As Object, FSO As Object, ShApp As Object, références As Object
    Dim dossier As Object, fichier As Object, fichier_texte As Object
    Dim répertoire_zip As String, répertoire_unzip As Variant
    Dim CellVide As Range
    Dim infos() As String, référence As String, P_référence As String, lib_P_réf As String, test As String, contenu_fichier As String
    Dim nb_itération As Integer, i As Integer
    Dim date_i As Date

    '// Assignation des répertoires
     Set WS = CreateObject("WScript.Shell")
    répertoire_zip = WS.SpecialFolders("MyDocuments") & "\Macro XXX\zip"
    répertoire_unzip = WS.SpecialFolders("MyDocuments") & "\Macro XXX\ecu"

    '// Assignation application Shell, objet gestion de fichiers et collection de type dictionnaire pour les références
     Set ShApp = CreateObject("Shell.Application")
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set références = CreateObject("Scripting.Dictionary")

    '// Balayage des fichiers .zip se trouvant dans le répertoire et dézippage
     Set dossier = FSO.GetFolder(répertoire_zip)
    For Each fichier In dossier.Files
        If FSO.GetExtensionName(fichier.Path) = "zip" Then
            ShApp.Namespace(répertoire_unzip).CopyHere ShApp.Namespace(fichier.Path).items
            infos = Split(fichier.Name, "-")
            référence = infos(0)
            If Not références.Exists(référence) Then références.Add Key:=référence, Item:=0
            If infos(2) = "OK" Then références(référence) = références(référence) + 1
        End If
    Next fichier

    '// traitement des fichiers se trouvant dans le répertoire de dézippage
     Set dossier = FSO.GetFolder(répertoire_unzip)
    For Each fichier In dossier.Files
        '/suppression des fichiers .xls et .xml se trouvant dans le répertoire de dézippage
         If FSO.GetExtensionName(fichier.Path) = "xls" _
        Or FSO.GetExtensionName(fichier.Path) = "xml" Then
            fichier.Delete
        Else
            '/écriture des infos associées au fichiers .ecu dans la feuille active
             If FSO.GetExtensionName(fichier.Path) = "ecu" Then
                'recherche première cellule vide en colonne A de la feuille active
                 Set CellVide = ActiveSheet.Columns("A").Find(Null)
                If CellVide Is Nothing Then Set CellVide = Range("A1")
                'récupération des infos associées au fichier .ecu
                 infos = Split(Replace(fichier.Name, ".ecu", ""), "-")
                référence = infos(0)
                nb_itération = références(référence)
                'écriture des infos dans la feuille active
                 CellVide = fichier.Name
                CellVide.Offset(, 1) = référence
                CellVide.Offset(, 2) = infos(5)
                CellVide.Offset(, 3) = infos(4)
                CellVide.Offset(, 4) = infos(1)
                CellVide.Offset(, 5) = nb_itération
                If nb_itération > 0 Then CellVide.Offset(, 6) = "OK" Else CellVide.Offset(, 6) = "KO"
                'lecture du fichier
                 Set fichier_texte = FSO.OpenTextFile(fichier.Path, 1)   'ouverture en lecture seule
                 contenu_fichier = fichier_texte.ReadAll                 'lecture du contenu
                 fichier_texte.Close                                     'fermeture
                'écriture préférences
                 infos = Split(contenu_fichier, Chr(10) & "P")
                For i = 1 To UBound(infos)
                    P_référence = "P" & Left(infos(i), 7)
                    lib_P_réf = Right(infos(i), Len(infos(i)) - 7)
                    CellVide.Offset(, 5 + i * 2) = P_référence
                    CellVide.Offset(, 6 + i * 2) = Split(lib_P_réf, "Information")(0) & " Information"
                Next i
            End If
        End If
    Next fichier

End Sub

Bsr Thev,

Maintenant tt est à OK il n'y a pas de résultat test à KO et en PJ le contenu du .ecu

Merci

Rechercher des sujets similaires à "creation indicateur"