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
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
- Messages
- 4'064
- Excel
- 2021 FR 64 bits
- Inscrit
- 13/06/2016
- Emploi
- bénévole associations Goutte d'Or
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
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) ?
- Messages
- 4'064
- Excel
- 2021 FR 64 bits
- Inscrit
- 13/06/2016
- Emploi
- bénévole associations Goutte d'Or
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
- Messages
- 4'064
- Excel
- 2021 FR 64 bits
- Inscrit
- 13/06/2016
- Emploi
- bénévole associations Goutte d'Or
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
- Messages
- 4'064
- Excel
- 2021 FR 64 bits
- Inscrit
- 13/06/2016
- Emploi
- bénévole associations Goutte d'Or
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
- Messages
- 4'064
- Excel
- 2021 FR 64 bits
- Inscrit
- 13/06/2016
- Emploi
- bénévole associations Goutte d'Or
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
- Messages
- 4'064
- Excel
- 2021 FR 64 bits
- Inscrit
- 13/06/2016
- Emploi
- bénévole associations Goutte d'Or
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
sinon j'ai su deplacé la récupération (ridicule pour vous j'imagine mais pour moi une petite victoire
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
- Messages
- 4'064
- Excel
- 2021 FR 64 bits
- Inscrit
- 13/06/2016
- Emploi
- bénévole associations Goutte d'Or
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
- Messages
- 4'064
- Excel
- 2021 FR 64 bits
- Inscrit
- 13/06/2016
- Emploi
- bénévole associations Goutte d'Or
quel résultat obtenez-vous par rapport à celui à obtenir ?Oudot a écrit :récupération des P référence
Communiquez-moi la liste des noms des fichiers ZIP et des fichiers ECU. Je suis basé sur votre explication :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)
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".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.
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
- Messages
- 4'064
- Excel
- 2021 FR 64 bits
- Inscrit
- 13/06/2016
- Emploi
- bénévole associations Goutte d'Or
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
Merci