Suppression ligne vierge dans procédure

Version imprimable

Bonjour le fofo,

Je sollicite votre aide afin de modifier un vbs.

Pour faire simple, le traitement est le suivant :

- Ouverture d'un fichier texte dans un rep (le nom change à chaque semaine)
- Si présence d'un terme alors suppression de la ligne
- Réécriture du fichier et ensuite le traitement continue (copie dans un nouveau rep, émail, etc...)

je m'en sors si tous les termes que je supprime sont tous à la fin, là RAS mon script fonctionne. Le hic c'est si certaines lignes non désirées se retrouvent ailleurs, je me retrouve dès lors avec des lignes vierges ce que je ne veux pas.

Comment rajouter dans mon vbs cette notion de suppression de ligne vide ?

je mets une partie de mon code pour illustrer un peu mes propos :
Code:

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 Const OpenFileForReading = 1 Const OpenFileForWriting = 2 dim FSO, text, readfile,Writefile, fic_Err, FichierErreur,contents,newContents,DteMED,NewDteMED,DteResil,NewDteResil,DteSUS,NewDteSUS,Cli,Ctr,DteDebut Dim A_MED(),Index,A_Ctr,Trouve, I Dim f, fc, f1, Rep_Destination, Fic_Copie, objMessage Rep_Destination = "D:\Users\bidule\" set FSO = CreateObject("Scripting.FileSystemObject") Set f = fso.GetFolder(getpath()) Set fc = f.Files For Each f1 in fc If left(f1.name,13) = "blabla" and lcase(right(f1.name,8)) <> "_new.txt" then set readfile = FSO.OpenTextFile(getpath() & f1.name, OpenFileForReading, false) set Writefile = FSO.OpenTextFile(getpath() & left(f1.name,len(f1.name)-4) & "_new.txt", OpenFileForWriting, true) Index = 1 do while readfile.AtEndOfStream = false contents = readfile.ReadLine if right(ltrim(rtrim(Contents)),20) = "Mon Terme que je veux shooter" then ' * Nouvelles Lignes newContents = "" ' et c'est ici que je sèche ...
Merci par avance ...

:salut:
Je ne sais si ça peut résoudre votre problème de ligne vide :roll:

Code:

1
2
3
4
5
Do while readfile.AtEndOfStream = false
        contents = readfile.ReadLine
        contents = Trim(contents)
        If Len(contents) > 0 Then
.........

14/10/2019, 15h50
don_pets
Merci hackoofr pour ton retour,

tu rajoutes une seconde boucle à ma boucle ?

Car moi pour mon instruction c'est du genre boucle sur chaque ligne et si sur celle-ci tu trouves le terme, disons "plouf" alors tu shoot la ligne ce que je traduis par
Code:

1 2 3 4 do while readfile.AtEndOfStream = false contents = readfile.ReadLine if right(ltrim(rtrim(Contents)),20) = "Mon Terme que je veux shooter" then newContents = ""
Et ce serait à la fin de cette procédure que tu rajouterais un deuxième do while ?

Autant en vba j'ai certaines notions, autant en vb je cale un peu ...

Non, Je n'ai pas ajouté de boucle mais c'est qu'il faut ajouter les deux lignes dans votre boucle elle-même

Code:

1
2
3
4
5
6
7
8
9
10
do while readfile.AtEndOfStream = false
	contents = readfile.ReadLine
	contents = Trim(contents)
	If Len(contents) > 0 Then      
		If right(ltrim(rtrim(Contents)),20) = "Mon Terme que je veux shooter" then
			...........
			..........
		end if
	end if
	newContents = ""

15/10/2019, 09h54
don_pets

Je ne sais pas si j'ai correctement interprété ton idée, mais toujours est-il que mon traitement ne me remonte aucune erreur, toutefois mes lignes vierges sont toujours vierges.

Voila ce que j'ai dans mon fichier avant traitement :

1234blabla
4567blabla
7879trucbidule
753trucbidule
951blabla

si le terme désigné est trucbidule, je souhaiterais avoir en résultat

1234blabla
4567blabla
951blabla

or avec mon code (et y compris avec le tiens) j'obtiens

1234blabla
4567blabla

951blabla

Donc ce que j'imaginais c'est qu'à la fin de mon instruction (après lui avoir dit la ligne devient "" si tu trouves trucbidule) si tu vois une ligne vierge tu la supprimes.

Essaie, tout en adaptant, ceci

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Option Explicit 
 
Const ForReading = 1, ForWriting = 2
Const Find = "trucbidule" ' Chaine à rechercher
Dim fso, Fich, Ret, NewText
 
Set fso = CreateObject("Scripting.FileSystemObject") 
 
Set fich = fso.OpenTextFile("Test.txt", ForReading, False) 
Do While Not Fich.AtEndOfStream
   Ret = Fich.ReadLine
   If InStr(1, LCase(Ret), Find) = 0 And Ret <> "" Then
      NewText = NewText & Ret & vbNewLine
   End If
Loop
Fich.Close
 
Set fich = fso.OpenTextFile("Test.txt", ForWriting, True)
Fich.Write NewText
Fich.Close

Hello Autodidacte,

merci pour ta contribution je me rapproche du truc !!

deux questions :

- À priori on ne peux pas pour la const find mettre une expression avec plusieurs mots genre "tralala bidule"
- donc mon vbs je ne connais pas le nom de mon fichier, suis obligé de passer par un getpath du genre
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 et FSO = CreateObject("Scripting.FileSystemObject") Set f = fso.GetFolder(getpath()) Set fc = f.Files '----------------------------------------- dô_Ôb ----------------------------------------- ' 1.c) Recherche For Each f1 in fc If left(f1.name,13) = "début de mon nom de fichier txt" and lcase(right(f1.name,8)) <> "_new.txt" then set readfile = FSO.OpenTextFile(getpath() & f1.name, OpenFileForReading, false) set Writefile = FSO.OpenTextFile(getpath() & left(f1.name,len(f1.name)-4) & "_new.txt", OpenFileForWriting, true)
as tu une idée de comment l'adapter ?

15/10/2019, 15h35
don_pets

Oublie la première question, j'ai du faire ma quiche, ça me prend parfaitement l'ensemble de mes caractères

me reste plus qu'à gérer la variable du nom, si tu as une idée je suis toujours preneur :)

Bon au final,

Quand on a trop le nez dedans on ne voit pas forcément clair. Avec un peu de recul j'ai pu facilement, merci à vous deux, obtenir ce que je voulais. Maintenant je vais continuer mon script (déplacement fichiers, écriture journal log, émails, etc...).

Je vous remercie pour votre aide, c'est grâce à ce genre de forum, que l'on progresse.

Je mets ci-dessous le bout de code dont je vais me servir cela pourra toujours aider quelqu'un. Pour rappel le scénario est simple, on va ouvrir un .txt dont on ne connaît pas le nom complet, on va l'ouvrir et supprimer les lignes où se trouvent un terme.

Code:

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
 
 
Option Explicit
 
Const	OpenFileForReading		= 1
Const	OpenFileForWriting		= 2
Const	OpenFileForAppending 	= 8
Const 	olMailItem 			= 0
Const	xlEdgeLeft				= 7
Const	xlEdgeTop				= 8
Const	xlEdgeBottom			= 9
Const	xlEdgeRight			= 10
Const	xlInsideVertical		        = 11
Const	xlInsideHorizontal		= 12
Const 	adCmdStoredProc 		= 4 
Const 	xlFillDefault 			= 0
Const	Ajout_Jour_MED		= 30
Const	Ajout_Jour_SUS			= 30
Const	Ajout_Jour_RES			= 10
Const   Find 					= "Terme qu'on en veut pas"
 
dim FSO, text, readfile,Writefile, fic_Err, FichierErreur,contents,newContents,DteMED,NewDteMED,DteResil,NewDteResil,DteSUS,NewDteSUS,Cli,Ctr,DteDebut
Dim A_MED(),Index,A_Ctr,Trouve, I
Dim f, fc, f1, Rep_Destination, Fic_Copie, objMessage
Dim  Ret, NewText
 
'-----------------------------------------  dô_Ôb  -----------------------------------------
 
'       1.b) Ouverture
Rep_Destination = "D:\Users\tintin\Documents\"
 
set FSO = CreateObject("Scripting.FileSystemObject")
Set f = fso.GetFolder(getpath())
Set fc = f.Files
 
'-----------------------------------------  dô_Ôb  -----------------------------------------
 
'       1.c) Recherche du txt
	For Each f1 in fc
		If left(f1.name,13) = "Début_Nom" and lcase(right(f1.name,8)) <> "_new.txt" then
			set readfile = FSO.OpenTextFile(getpath() & f1.name, OpenFileForReading, false)
			set Writefile = FSO.OpenTextFile(getpath() & left(f1.name,len(f1.name)-4) & "_new.txt", OpenFileForWriting, true)
'-----------------------------------------  dô_Ôb  -----------------------------------------
 
'		1.d) Création fichier log
Fic_Err = Left(f1.name,Len(f1.name) -4) & ".Log"
Set FichierErreur = FSO.OpenTextFile(Fic_Err, OpenFileForWriting, true )
 
'-----------------------------------------  dô_Ôb  -----------------------------------------
 
'		2.a) Recherche du terme qu'on en veut pas
	do while readfile.AtEndOfStream = false
	Ret = readfile.ReadLine
		If InStr(1, LCase(Ret), Find) = 0 And Ret <> "" Then
			NewText = NewText & Ret & vbNewLine
		End If
	loop
 
		End if
	Next
 
'-----------------------------------------  dô_Ôb  -----------------------------------------
 
'		2.a) Fermeture Fichier
readfile.Close
Writefile.Write NewText
Writefile.Close
 
'-----------------------------------------  dô_Ôb  -----------------------------------------
'       2.a) Fonction
 
Function GetPath()
 
	Dim path
	path = WScript.ScriptFullName
	GetPath = Left(path, InStrRev(path, "\"))
 
End Function

Enjoy