Remplacement d'une chaîne de caractères dans plusieurs fichiers txt

Version imprimable

29/08/2017, 10h38
antibab13

Remplacement d'une chaîne de caractères dans plusieurs fichiers txt

Bonjour a tous

Je suis un peu novice dans le domaine de VBS et je sollicite donc vos lumières :oops:.

Voila mon problème, j'ai plusieurs fichier .txt qui contiennent les ventes de la semaine de nos boutiques (je travaille de la distribution textile). A l’intérieur de ces fichiers (dont le nombre est variable d'une semaine a l'autre) il y a des codes de boutiques avec la syntaxe suivante :

;82;
;83;
;86;

Ces codes ne sont pas exploitable par notre logiciel tel quel et je dois les modifier manuellement un à un avec la syntaxe suivante :

;082;
;083;
;086;

J'aurai besoin de votre aide pour créer une boucle qui test tout les fichiers d'un dossier (ex: C:\test) et qui remplace les anciens codes boutiques par ceux désirés.

J'espere que ma demande est claire.

Merci d'avance pour l'aide que vous pourriez m'apporter ;).

Salut

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
Sub ModifFichier(CheminNomFichier)
        Const ForReading = 1
        Const ForWriting = 2
        Dim objFSO, F
        Set objFSO = CreateObject("Scripting.FileSystemObject")
        Dim TblLignesLut, T, RecupChiffre
	TblLignesLut = Split(objFSO.OpenTextFile(CheminNomFichier, ForReading).ReadAll, vbNewLine)
 
        For T = 0 To UBound(TblLignesLut)
                RecupChiffre = Cint(replace(TblLignesLut(T),";",""))
                TblLignesLut(T)= ";" & String(3-Len(RecupChiffre),"0") & RecupChiffre & ";"
        next
        Set F = objFSO.OpenTextFile(CheminNomFichier, ForWriting, True)
        F.Write Join(TblLignesLut,vbNewLine)
        F.Close
        Set F = Nothing
        Set TblLignesLut = Nothing
        Set objFSO = Nothing
 
 End Sub
 
 ModifFichier "C:\Provisoir\Test.txt"
 ModifFichier "C:\Provisoir\Test2.txt"
' ModifFichier "C:\Provisoir\............"
MsgBox "Fait", vbInformation

En appelant la sub ModifFichier tu peux donc boucler pour chacun des fichiers.
Reste à savoir s'il n'est pas dommageable d'écraser le fichier source? car le fichier est sauvegardé sous le même nom.

29/08/2017, 14h10
antibab13

Merci ProgElecT pour ta réponse j'ai parcouru ton code apparemment il fait une recherche sur le caractère ";" si j'ai bien compris (j'ai peut être mal compris aussi :oops:).
Le problème c'est que ce caractère est présent sur la totalité du document (c'est un délimiteur), donc si je l'applique tel quel je pense qu'il va me mettre des 0 partout.

Merci encore une fois pour ton aide

PS : Pourrai tu m'expliquer pas a pas le fonctionnement du code et merci encore une fois

Re

Dans le fichier test.txt avant modification

Citation:

;82;
;83;
;86;
;6;
;123;

Après

Citation:

;082;
;083;
;086;
;006;
;123;

Essais le programme :D, en désignant le bon chemin/nom de fichier.

Citation:

PS : Pourrai tu m'expliquer pas a pas le fonctionnement du code et merci encore une fois

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
'ouvre en lecture le fichier en récupérant chaque lignes qui sont mises dans la variable tableau TblLignesLut
TblLignesLut = Split(objFSO.OpenTextFile(CheminNomFichier, ForReading).ReadAll, vbNewLine)
 
'parcours tout le tableau
For T = 0 To UBound(TblLignesLut)
	'recupére chaque chiffre en supprimant les ; (replace par rien)
	RecupChiffre = Cint(replace(TblLignesLut(T),";",""))
	'modifie chaque variable tableau en lui ajoutant le nombre de zéros voulus pour former un mot de 3 caractères
	' plus le caractère ; de chaques cotés
	TblLignesLut(T)= ";" & String(3-Len(RecupChiffre),"0") & RecupChiffre & ";"
next
'ouvre le même fichier en écriture
Set F = objFSO.OpenTextFile(CheminNomFichier, ForWriting, True)
'écrit la concaténation du tableau TblLignesLut en séparent chacune des variables par un saut de ligne
F.Write Join(TblLignesLut,vbNewLine)
'ferme le fichier
F.Close

1 pièce(s) jointe(s)

Bon j'ai essayé le code en remplaçant le chemin par le miens :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Sub ModifFichier("C:\Users\b.mehdi\Desktop\TR290817\IBT")
        Const ForReading = 1
        Const ForWriting = 2
        Dim objFSO, F
        Set objFSO = CreateObject("Scripting.FileSystemObject")
        Dim TblLignesLut, T, RecupChiffre
	TblLignesLut = Split(objFSO.OpenTextFile("C:\Users\b.mehdi\Desktop\TR290817\IBT", ForReading).ReadAll, vbNewLine)
 
        For T = 0 To UBound(TblLignesLut)
                RecupChiffre = Cint(replace(TblLignesLut(T),";",""))
                TblLignesLut(T)= ";" & String(3-Len(RecupChiffre),"0") & RecupChiffre & ";"
        next
        Set F = objFSO.OpenTextFile("C:\Users\b.mehdi\Desktop\TR290817\IBT", ForWriting, True)
        F.Write Join(TblLignesLut,vbNewLine)
        F.Close
        Set F = Nothing
        Set TblLignesLut = Nothing
        Set objFSO = Nothing
 
 End Sub

Mais j'ai le message d'erreur suivant :

Pièce jointe 307480

L'appel de la sub se fait comme ceci

Code:

ModifFichier "C:\Provisoir\Test.txt"

A la place de "C:\Provisoir\Test.txt" tu dois mettre "C:\Users\b.mehdi\Desktop\TR290817\IBT"
Ton Chemin nom de fichier se termine par IBT, étonnant car en général le fichier devrait se terminer par .TXT comme tu l'indiques dans ton premier message.
Donc tu ne modifies pas cette partie du

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Sub ModifFichier(CheminNomFichier)
        Const ForReading = 1
        Const ForWriting = 2
        Dim objFSO, F
        Set objFSO = CreateObject("Scripting.FileSystemObject")
        Dim TblLignesLut, T, RecupChiffre
	TblLignesLut = Split(objFSO.OpenTextFile(CheminNomFichier, ForReading).ReadAll, vbNewLine)
 
        For T = 0 To UBound(TblLignesLut)
                RecupChiffre = Cint(replace(TblLignesLut(T),";",""))
                TblLignesLut(T)= ";" & String(3-Len(RecupChiffre),"0") & RecupChiffre & ";"
        next
        Set F = objFSO.OpenTextFile(CheminNomFichier, ForWriting, True)
        F.Write Join(TblLignesLut,vbNewLine)
        F.Close
        Set F = Nothing
        Set TblLignesLut = Nothing
        Set objFSO = Nothing
 
 End Sub

Tu adaptes pour ton chemin nom de fichier comme cela

Code:

1
2
 ModifFichier "C:\Users\b.mehdi\Desktop\TR290817\IBT.txt"
MsgBox "Fait", vbInformation

30/08/2017, 10h15
antibab13

Merci pour tout ProgElecT mon problème est résolu:yaisse1::ave::lahola:

Salut à vous deux et aux autres ;

Heureux que ce soit résolu.

J'aurais une proposition qui donnerait le résultat escompté(un peu plus longue) si chaque ligne contient un seul "code" :

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
Option Explicit 
 
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Dim fso, Fich1, Fich2, Ret, TBLigneLue, Ind, K, SousChaine, Recherche
 
Set fso = CreateObject("Scripting.FileSystemObject") 
 
Set fich1 = fso.OpenTextFile("Ventes.txt", ForReading, False) ' Adapter le chemin
Set fich2 = fso.OpenTextFile("VentesAfter.txt", ForAppending, True) ' Nouveau fichier pour ne pas toucher à l'original
Ret = fich1.ReadALL
fich1.Close
TBLigneLue = Split(Ret, vbNewLine, -1, vbTextCompare)
For K = 0 To Ubound(TBLigneLue)
    Ret = TBLigneLue(K)
    Ind = 0
    Recherche = ""
    Do
       Ind = Ind + 1
       SousChaine = SousChaine & Mid(Ret, Ind, 1)
       If Asc(Mid(Ret, Ind, 1)) >= 48 And Asc(Mid(Ret, Ind, 1)) <= 57 Then 
          Recherche = Recherche & Mid(Ret, Ind, 1)
       End If
    Loop Until Ind >= Len(Ret)
'    MsgBox Recherche ' Juste pour le test
    SousChaine = Replace(SousChaine, Recherche, Right("00" & Recherche, 3))
    Fich2.Write SousChaine & vbNewLine
    Recherche = "" : SousChaine = ""
Next
Fich2.Close
' Nettoyage
Set fich1 = Nothing
Set fich2 = Nothing
Set fso = Nothing

Tu peux construire une procédure Sub à partir de ce code puis l'appeler avec le nom complet du fichier à traiter