Recherche et remplacement de chaine

Version imprimable

24/02/2009, 08h59
dubinc38

Recherche et remplacement de chaine

Salut tout le monde ;) ,

Je recherche comment supprimer une ligne contenant un caractere spéciale ou éventuellement la remplacer par une autre chaine le tout devant pouvoir etre fait pour l'ensemble des fichiers .txt d'un repertoire.

J'arrive à rechercher la chaine avec la fonction Instr

Par contre je ne sais pas comment supprimer la ligne si quelqu'un a une astuce je suis tout ouie 8O:mrgreen:

en sachant que je fait une premiere recherche de chaine et dasn le cas ou je trouve cette chaine alors j'effectue une deuxieme recherche dans ce meme fichier pour le remplacement.

Parcour du repertoire
Parcours de tt les fichier txt
Lecture ligne par ligne de chacun
Si chaineA presente
alors
Rechercher chaine B
Si chaine b présente
alors supprimer cette ligne ou la remplacer
Fsi
Fsi

merci et bonne journée

Ca donne un truc comme cà :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
	Dim ts
    Dim fso
    Dim sFileText
    Const ForReading = 1 ' utilisé par FSO
    Const ForWriting = 2 ' utilisé par FSO
 
	src = "C:\toto.txt"
 
    ' Initialise le FSO 
    Set objFSO = CreateObject("Scripting.FileSystemObject") 
    ' Ouvre le fichier en lecture 
    Set ts = objFSO.OpenTextFile(src, ForReading, False) 
    ' Lit son contenu 
    sFileText = ts.ReadAll
    ' Ferme le fichier 
    Call ts.Close 
    ' Ouvre le fichier en écriture 
    Set ts = objFSO.OpenTextFile(src, ForWriting, False) 
    ' Modifie son contenu en remplacant la chaine 
    Call ts.Write(Replace(sFileText, "texte à chercher", "texte de remplacement"))
    ' Ferme le fichier modifié
    ts.Close

en effet ton code fonctionne bien mais mon soucy qui au final est recurrent c 'est que je n'arrive pas a l 'adapter a ce que j'ai fait personnellement.

Je crois qu'en faite mon probleme reside dans le fait que j'ouvre mon fichier une fois seulement et donc je peut pas faire a la fois l ecriture la recherche et la copie...du coup je me retrouve toujours avec des depassements de fichiers.....:aie::aie::aie:

Celon toi pense tu qu 'il est possible d'arriver a l'adapté a cette base ou alors faut t'il vraiment repartir a zero car je bloque sur la derniere etape mais apparament à cause de l'ensemble de mon code :traine: ;

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
Option Explicit 
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Dim objFso, objFile,objFolder, strPath, strExt,fso,WshShell,ftxt,oFso
Dim File, Result,Texte,sChaine,pos,f,proclu,exp2k21,i,lignes,tableau,fichier
'Répertoire à parcourir
strPath = "cheminrepertoire"
'Extension à rechercher
strExt = "txt"
'Création du dossier pour la copie
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.CreateFolder("chemin de creation")
Set objFso = CreateObject("Scripting.FileSystemObject")
 
'----------
'Saisie de l'imprimante à rechercher et de l'imprimante à ajouter
'----------
exp2k21 = inputbox("saisir le nom de la file à rechercher [exp2k21]")
sChaine ="netprinter|\\exp2k21\"&exp2k21&"|"
proclu = inputbox("saisir le nom de l'imprimante à ajouter [proclu01ps]")
 
'----------
'Parcour du répertoire puis de tout les fichiers txt presents
'----------
Call ShowFileTxtFolder(strExt)
 
Set objFso = Nothing
 
Function ShowFileTxtFolder (strExt)
For Each objFile In objFso.GetFolder(strPath).Files
    If LCase(objFso.GetExtensionName(objFile.Path)) = LCase(strExt) Then
       Set File = objFso.OpenTextFile(objfile.Path, ForReading)
        'affichage de toute les lignes une par une tant qu'on est pas à la fin du fichier 
 
lignes = File.Readline
'Convertion en minuscule de la ligne avant recherche
	lignes = Lcase(lignes)
'----------
' Recherche d'une chaine de caractère dans une ligne + Ajout nouvelle ligne + copie du fichier dans repertoire
'----------
pos=InStr(lignes,schaine)
if pos = 1 then 
       'Ajout de la ligne relative à Proclu01ps
        Set WshShell = WScript.CreateObject("WScript.Shell")
				Set fso = CreateObject("Scripting.FileSystemObject")
				Set fichier = fso.OpenTextFile(objfile.Path,8,true)
				fichier.writeline("Netprinter|\\proclu01ps\"& proclu &"|Y")
				'instanciation
				Set FSO = CreateObject("Scripting.FileSystemObject")
				'Copie du fichier
				Set Ftxt = fso.GetFile(objfile.Path)   'Fichier origine
				Ftxt.copy("chemincopie") 'emplacement destination
end if 
wend
File.Close
Set File = nothing
End if   
Next
End Function

Bonjour,

je pense qu'il faut là encore que tu passe par des fichiers temporaires (surtout si tes fichiers sont un peu gros).

Voilà une méthode qui devrait fonctionner :

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
strFolder = "chemin du dossier"
strExt = "txt"
strToSearch = "texte a chercher"
Set objFso = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFso.GetFolder(strFolder)
For Each objFile In objFolder.Files
	strFilePath = objFile.Path
	If LCase(objFso.GetExtensionName(strFilePath)) = LCase(strExt) Then
		Set objTempStream = objFso.OpenTextFile(strFilePath, 1)
		Set objTempNewFile = objFso.CreateTextFile(strFilePath & ".temp", 2)
		Do While NOT objTempStream.AtEndOfStream
			strTemp = objTempStream.ReadLine
			If Instr(strTemp, strToSearch) = 0 Then
				objTempNewFile.WriteLine strTemp
			Else
				objTempNewFile.WriteLine "Texte de remplacement"
			End If
		Loop
		objTempStream.Close
		objTempNewFile.Close
		objFile.Delete
		objFso.MoveFile strFilePath & ".temp", strFilePath
	End If
Next
Wscript.Echo "Fin du programme"

24/02/2009, 12h41
dubinc38

roo merci beaucoup :yaisse2:

sa ma grandement avancé je l'adapte un peu et je pense que sa devrait le faire parfaitemement

Merci je retourne dessus ;)

Re,

Et voila sa marche tout bien merci à tout ceux qui m'ont aider que ce soit dans ce topic ou dans les précédents:king:

je vous passe donc le code defois que sa puisse servir à quelqu'un d 'autre
Par contre je vous assure pas que ce soit digne du meilleur devellopeur :mouarf::lol:

Option Explicit

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
79
80
81
82
83
84
85
86
'----------
'déclaration des variables et constante
'----------
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Dim objFso, objFile,objFolder, strPath, strExt,fso,WshShell,ftxt,oFso,strdossier,strextension,strToSearch,strFilePath,objTempStream,objTempNewFile,strtemp
Dim File,sChaine,pos,proclu,exp2k21,lignes,schaine2
strExtension = "txt"
strToSearch = "END"
'----------
'Chemin du repertoire à parcourir et extension à rechercher
'----------
strPath = "cheminrepertoire"
strExt = "txt"
 
'----------
'Création du dossier pour la copie
'----------
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.CreateFolder("cheminderepertoirepourlacopie")
Set objFso = CreateObject("Scripting.FileSystemObject")
 
'----------
'Saisie de l'imprimante à rechercher et de l'imprimante à ajouter
'----------
exp2k21 = inputbox("saisir le nom de la file d'impression à rechercher sur le serveur [exp2k21]")
sChaine ="netprinter|\\exp2k21\"&exp2k21&"|"
proclu = inputbox("saisir le nom de l'imprimante à ajouter sur le serveur [proclu01ps]")
schaine2="netprinter|\\proclu01ps\"&proclu&"|Y"
 
'----------
'Parcour des fichiers txt du repertoire + convertion en minuscule de chaque ligne de fichier
'----------
Call ShowFileTxtFolder(strExt)
Set objFso = Nothing
Function ShowFileTxtFolder (strExt)
For Each objFile In objFso.GetFolder(strPath).Files
    If LCase(objFso.GetExtensionName(objFile.Path)) = LCase(strExt) Then
       Set File = objFso.OpenTextFile(objfile.Path, ForReading)
	while Not File.AtEndOfStream   
	lignes = File.Readline	
	lignes = Lcase(lignes)
'----------
' Recherche d'une chaine de caractère dans les lignes du fichier txt 
' Copie du fichier dans le nouveau repertoire si chaine trouvée
'----------
pos=InStr(lignes,schaine)
if pos = 1 then      
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Ftxt = fso.GetFile(objfile.Path)'fichier source   
Ftxt.copy("chemin du repertoire de copie") 
end if 
wend
File.Close
Set File = nothing
End if   
Next
'----------
' Recherche et remplacement de la chaine END pour l 'ensemble des fichiers déplacés 
' Par le mappage de l'imprimante sur proclu01ps 
' Rajout de END en fin de fichier
'----------
strdossier = "toujour le repertoire de la copie" '===>'chemin du repertoire à parcourir
Set objFso = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFso.GetFolder(strdossier)
For Each objFile In objFolder.Files
	strFilePath = objFile.Path
	If LCase(objFso.GetExtensionName(strFilePath)) = LCase(strExtension) Then
		Set objTempStream = objFso.OpenTextFile(strFilePath, 1)
		Set objTempNewFile = objFso.CreateTextFile(strFilePath & ".temp", 2)
		Do While NOT objTempStream.AtEndOfStream
			strTemp = objTempStream.ReadLine
			If Instr(strTemp, strToSearch) = 0 Then
				objTempNewFile.WriteLine strTemp
			Else
				objTempNewFile.WriteLine schaine2
				objTempNewFile.WriteLine "END"
			End If
		Loop
		objTempStream.Close
		objTempNewFile.Close
		objFile.Delete
		objFso.MoveFile strFilePath & ".temp", strFilePath
	End If
Next
End Function
Wscript.Echo "Fin du programme"