Discussion :

[Invité]

Bonjour,
J’aimerais récupérer les informations du fichier texte joint « rapport.txt » et les intégrer dans un tableau Excel afin d’avoir une vue d’ensemble.
L’idée en colonne les horaires sur 24 heures en minutes et en lignes de chaque jour.
Dans ce tableau incrémenter les valeurs :
Maximum = XXXX en MS
Le jour et l’heure
Dans le but d’avoir un visu global afin de Déterminer si ces valeurs sont aléatoires ou récurrentes dans le temps.
rapport.txt
Rapport_Visu.xlsx

[Invité]

Un 1er essaie, histoire de me familiariser avec l’objet Excel depuis VB.
Donc
Un fichier texte contenant 2 lignes :

test N°1 lecture TXT écriture XLSX ligne 1
test n°2 lecture TXT écriture XLSX ligne 2

Et un fichier Excel.

Le but : récupérer « test N°1 » et « ligne 1 » est les placers respectivement dans les cellules A1 et A2
Idem pour la deuxième ligne en B1 et B2.

Ça fonctionne mais j’ai un petit souci.

1- Mes fichiers sont placés dans le même répertoire que le script, je ne parviens pas a les faire prendre en charge sans mettre le chemin en dure (App.Path).

2- Là, la récupération est faite en comptant le nombre de caractères, ce que je ne peux pas faire avec mon fichier « rapport.txt » vu que le nombre de caractères et changeant.

Comment géreriez-vous ? Avec des balises ?

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
Option Explicit
 
Const ForReading = 1
 
Dim MonFichierTxt, MonFichierXlsx, L1, L2,  FSO, LectureFichierTxt, ExcelObject, SheetObject, Ligne1, Ligne2, Cellule1_1, Cellule1_2, Cellule2_1, Cellule2_2
 
MonFichierTxt = "C:\test\Fichier_Source.txt"
 
Set FSO = CreateObject("Scripting.FileSystemObject")
 
Set LectureFichierTxt = FSO.OpenTextFile(MonFichierTxt, ForReading)
L1 = 1
L2 = 2
 
MonFichierXlsx = "C:\test\Fichier_Cible.xls"
 
Set ExcelObject = CreateObject("Excel.Application")
ExcelObject.WorkBooks.Open MonFichierXlsx
 
Set SheetObject = ExcelObject.ActiveWorkbook.Worksheets(1)
 
Do Until LectureFichierTxt.AtEndOfStream
 
	Ligne1 = LectureFichierTxt.ReadLine
 
	Cellule1_1 = Trim(Mid(Ligne1, 1, 8))
	Cellule1_2 = Mid(Ligne1, 36, 42)
 
	Ligne2 = LectureFichierTxt.ReadLine
 
	Cellule2_1 = Mid(Ligne2, 1, 8)
	Cellule2_2 = Mid(Ligne2, 36, 42)
 
     SheetObject.Cells(L1, 1).Value = Cellule1_1 
     SheetObject.Cells(L1, 2).Value = Cellule1_2
     SheetObject.Cells(L2, 1).Value = Cellule2_1 
     SheetObject.Cells(L2, 2).Value = Cellule2_2  
 
     L1 = L1+ 1 
     L2 = L2 + 1 
Loop 
 
ExcelObject.ActiveWorkbook.Save
ExcelObject.ActiveWorkbook.Close
ExcelObject.Application.Quit

[ProgElecT]

Salut

1- Mes fichiers sont placés dans le même répertoire que le script, je ne parviens pas a les faire prendre en charge sans mettre le chemin en dure (App.Path).

Code :

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

1
2
3
4
5
6
7
Dim DossProg, MonFichierTxt, MonFichierXlsx
 
DossProg = replace(WScript.ScriptFullName,WScript.ScriptName,"")
MonFichierTxt = DossProg & "Fichier_Source.txt"
MonFichierXlsx = DossProg & "Fichier_Cible.xls"
MsgBox "MonFichierTxt = " & MonFichierTxt & vbNewLine & vbNewLine & _
       "MonFichierXlsx = " & MonFichierXlsx

[Invité]

Décidément je ne suis pas du tout à mon aise avec Excel.
Un petit coup de main SVP ?

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
60
61
62
63
64
65
66
67
68
69
70
71
72
Option Explicit
 
Dim fso, DossProg, FichierTxt
Dim BaliseDebut, BaliseFin
Dim DebutOu, FinOu
Dim TblChapitre, TblLgn, Recup, T
Dim chaine1, chaine2, chaine3
 
 
Set fso = CreateObject("Scripting.FileSystemObject")
DossProg = replace(WScript.ScriptFullName,WScript.ScriptName,"")
Set FichierTxt = fso.opentextfile(DossProg & "rapport.txt", 1)
TblChapitre = Split(FichierTxt.ReadAll, "--------------------------------", -1, vbTextCompare)
FichierTxt.Close
Set FichierTxt = Nothing
 
BaliseDebut = "Maximum = "
BaliseFin = ", Moyenne"
For T = 0 To UBound(TblChapitre) - 1
    DebutOu = InStr(1, TblChapitre(T), BaliseDebut)
    If DebutOu <> 0 Then ' DebutOu a été trouvé
        DebutOu = DebutOu + Len(BaliseDebut)
        FinOu = DebutOu
        FinOu = InStr(FinOu, TblChapitre(T), BaliseFin)
        Recup = Mid(TblChapitre(T), DebutOu, (FinOu-2) - DebutOu) 'récupération du chiffre (tempo Maximum) pour ce Ping
 
           TblLgn = Split(TblChapitre(T), vbNewLine, -1, vbTextCompare) ' découpe en un tableau de chaque ligne du chapitre d'1 Ping 
 
 	   chaine1 = chaine1 & Recup & vbNewLine' & _
 	   chaine2 = chaine2 & Mid(TblLgn(1), 1, 10) & vbNewLine' & _ 	   							
 	   chaine3 = chaine3 & Trim(Mid(TblLgn(1), 12, Len(TblLgn(1)) - 15)) & vbNewLine 
 
      End If                              
Next
MsgBox chaine1
MsgBox chaine2
MsgBox chaine3
'Set FichierTxt = fso.CreateTextFile(DossProg & "rapport1.txt",True)
'FichierTxt.write chaine1
'FichierTxt.Close
'Set FichierTxt = Nothing
'MsgBox "Fait1"
'Set FichierTxt = fso.CreateTextFile(DossProg & "rapport2.txt",True)
'FichierTxt.write chaine2
'FichierTxt.Close
'Set FichierTxt = Nothing
'MsgBox "Fait2"
'Set FichierTxt = fso.CreateTextFile(DossProg & "rapport3.txt",True)
'FichierTxt.write chaine3
'FichierTxt.Close
'Set FichierTxt = Nothing
'Set fso = Nothing
'MsgBox "Fait3"
 
'----------------
Dim objExcel, strInput, FichierXlsx
 
strInput = chaine1
FichierXlsx = DossProg & "rapport1.xls"
 
Set objExcel = CreateObject("Excel.Application")
 
Set objWorkbook = objExcel.Workbooks.Open(strInput)
 
objExcel.ActiveWorkbook.SaveAs FichierXlsx, 1
objExcel.ActiveWorkbook.Close
objExcel.Application.Quit
 
'FichierTxt.Close
'Set FichierTxt = Nothing
Set fso = Nothing
MsgBox "Fait"

[ProgElecT]

Salut

Moi j'en suis ici

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
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
'avec regexp depuis le fichier rapport.txt
'(\d*/\d*/\d*) pour retrouver les dates --> 06/10/2017
'\d (\d*:\d*:\d*)|\d  (\d*:\d*:\d*) pour retrouver les heures --> 12:14:59
'- (\d*:\d*:\d*) pour trouver les ecarts --> 00:19:00
'Maximum = (\d*) pour trouver le temps maximum --> 592
Const ForReading = 1
Dim T, U
Dim DossProg, MonFichierTxt, MonFichierXlsx
Dim FSO, LectureFichierTxt
 
DossProg = replace(WScript.ScriptFullName,WScript.ScriptName,"")
MonFichierTxt = DossProg & "rapport.txt"
MonFichierXlsx = DossProg & "Rapport_Visu.xlsx"
 
Set FSO = CreateObject("Scripting.FileSystemObject")
Set LectureFichierTxt = FSO.OpenTextFile(MonFichierTxt, ForReading)
Dim StrFichier, TblDade, TblHeure, TblEcart, TblTmpMax
StrFichier = LectureFichierTxt.ReadAll
LectureFichierTxt.Close
Set LectureFichierTxt = Nothing
 
TblDade = recupTbl("(\d*/\d*/\d*)", StrFichier)  '46
TblHeure = recupTbl("\d (\d*:\d*:\d*)|\d  (\d*:\d*:\d*)", StrFichier)  '46
TblEcart = recupTbl("- (\d*:\d*:\d*)", StrFichier)  ' 46
TblTmpMax = recupTbl("Maximum = (\d*)", StrFichier)  '46
CreatExcel MonFichierXlsx
Set FSO = Nothing
MsgBox "FAIT"
'----------------------------------------------------------------------------------------------------------------------
Function recupTbl(ExpPattern, DansStr)
Dim RegularExpressioN, ResulT, Match, MsG
 
Set RegularExpressioN = New RegExp
RegularExpressioN.Pattern = ExpPattern
RegularExpressioN.IgnoreCase = True
RegularExpressioN.Global = True
Set ResulT = RegularExpressioN.Execute(DansStr)
For U = 0 To ResulT.Count - 1
    Set Match = ResulT(U)
    If Match.SubMatches.Count > 0 Then
        For T = 0 To Match.SubMatches.Count - 1
            If Trim(Match.SubMatches(T)) <> "" Then
                MsG = MsG & Match.SubMatches(T) & vbNewLine
            End If
        Next
    End If
    Set Match = Nothing
Next
Set ResulT = Nothing
Set RegularExpressioN = Nothing
recupTbl = Split(MsG, vbNewLine)
End Function
'----------------------------------------------------------------------------------------------------------------------
Sub CreatExcel(ChemFichExcel)
Dim L, C, ExcelObject, SheetObject, Ligne1, Ligne2, Cellule1_1, Cellule1_2, Cellule2_1, Cellule2_2
 
If FSO.FileExists(ChemFichExcel) Then FSO.DeleteFile ChemFichExcel, True
'https://vb.developpez.com/faq/vbs?page=Applications-Externes#Comment-piloter-Excel-pour-creer-un-classeur-xls
'https://vb.developpez.com/faq/?page=excel#creerclasseur
'http://drq.developpez.com/vb/tutoriels/Excel/
Set ExcelObject = CreateObject("Excel.Application")
ExcelObject.visible = true
Set SheetObject = ExcelObject.Workbooks.Add
 
L = 1: C = 66 ' C pour colonnes de 66 à 90  --> A à Z
SheetObject.Sheets(1).Range(Chr(C) & Cstr(L)) = " " & Cstr(TblDade(0)) 'ajout d'un espace pour forcer en string sinon la date est convertie au format anglais mois/jour/date
C = 67
For T = 1 To UBound(TblDade)-1
	If TblDade(T-1) <> TblDade(T) Then
		SheetObject.Sheets(1).Range(Chr(C) & Cstr(L)) = " " & Cstr(TblDade(T))
		C = C + 1
	End If
Next
 
SheetObject.SaveAs ChemFichExcel 'Sauve le classeur
SheetObject.Close False 'Ferme le classeur
Set SheetObject = Nothing 
ExcelObject.Application.Quit 
Set ExcelObject = Nothing 
End Sub
'----------------------------------------------------------------------------------------------------------------------

Je ne comprends pas trop tes lignes en colonne A.

[Invité]

Les lignes en colonne A reprennent un cycle de ping par 24H
Si pas de correspondance horaire avec le fichier rapport on laisse vide c’est qu’il n’y a pas eu de problème.
Si correspondance avec le fichier rapport on incrémente la cellule correspondante.
Exemple pour la 1ere détection du fichier rapport :

06/10/2017 12:14:59,01
Statistiques Ping pour 192.168.141.10:
Paquets envoyés = 20, reçus = 20, perdus = 0 (perte 0%),
Minimum = 0ms, Maximum = 592ms, Moyenne = 29ms

La cellule G736 ou G737 serrât incrémenter de la valeur 592 selon l’arrondit choisi.
G pour 06/10/2017
736 pour 12:14:00
737 pour 12:15:00