vylkor | Salut!
Merci pour la piste, j'ai eu le temps de creuser ça hier et j'ai pu sortir un petit bout de code.
Alors, le temps de calcul étant plus court que prévu (a peine 1 minute), finalement il y a pas de filtre au lancement de la macro, ce qui me donne:
Code :
- Sub GetFileNames()
- Dim xRow As Long
- Dim xDirectory$, xFname$, xRappSearch$, xTxtRapp$, xTxtEnt$, xRappNumber$
- Dim xDate As Date
- Dim cell As Range, fso As Object
- Dim Extract As String
- 'Nettoyate de la feuille
- Sheets("Sheet3" ).Cells.Clear
- 'On défini le chemin d'accès
- xDirectory$ = "\\laroute\"
- 'On défini le type de nom des fichers (*=chaine de caractère libre)
- xRappSearch$ = "rapp*.txt"
- 'On crée la liste de tous les fichiers dont le nom correspond
- xFname$ = Dir(xDirectory$ & xRappSearch$, 7)
- Do While xFname$ <> ""
- Sheets("Sheet3" ).Cells(1, 1).Offset(xRow) = xFname$
- xRow = xRow + 1
- xFname$ = Dir
- Loop
- 'Lancement de la boucle de recherche
- 'Set fso = CreateObject("Scripting.FileSystemObject" )
- On Error Resume Next
- For Each cell In Range(Cells(1, 1), Cells(1, 1).Offset(xRow))
- 'On cherche la date de création du rapport sur windows
- 'cell.Offset(0, 1).Value = fso.getfile(xDirectory$ & cell.Value2).DateCreated
- 'On recherche les dates et heures de début et fin de cycles dans les fichiers rapp*.txt
- xRapp$ = cell.Offset(0, 0)
- xTxtRapp$ = xDirectory$ & xRapp$
- Open xTxtRapp$ For Input Access Read As #1
- If IsEmpty(cell.Offset(0, 0)) Then Extract = ""
- For i = 1 To 3
- Line Input #1, Extract
- Next i
- xDate = Format(Right(Replace(Extract, ".", "/" ), 19), "dd/mm/yyyy hh:mm:ss" )
- cell.Offset(0, 1).Value = xDate
- Line Input #1, Extract
- xDate = Format(Right(Replace(Extract, ".", "/" ), 19), "dd/mm/yyyy hh:mm:ss" )
- cell.Offset(0, 2).Value = xDate
- Close #1
- 'On recherche les noms de programmes dans les fichiers ent*.txt correspondant au rapp*.txt
- xRappNumber$ = Right(xRapp$, Len(xRapp$) - 4)
- xRappNumber$ = Left(xRappNumber$, Len(xRappNumber$) - 4)
- xTxtEnt$ = xDirectory$ & "ENT" & xRappNumber$ & ".txt"
- If IsEmpty(cell.Offset(0, 0)) Then xTxtEnt$ = ""
- Open xTxtEnt$ For Input Access Read As #1
- For i = 1 To 2
- Line Input #1, Extract
- Next i
- 'On ne garde que le nom de programme (après le deuxième ":" )
- Extract = Right(Extract, Len(Extract) - InStr(Extract, ":" ))
- Extract = Right(Extract, Len(Extract) - InStr(Extract, ":" ))
- cell.Offset(0, 3).Value = Extract
- Close #1
- Next cell
- Set fso = Nothing
- On Error GoTo 0
- End Sub
|
Je vais chercher comment retrouver la présence des lignes "Test Conforme" ou "Test Non Conforme" au milieu des fichiers ENT0000.txt à une position aléatoire maintenant, je vais googler ça, mais si vous avez des pistes je suis preneur.
Merci! |