Ajout d'un suffixe à tout un ensemble de fichier d'un répertoire

Version imprimable

Bonjour à tous,

n'étant un expert vbs, j'aurai souhaité pouvoir ajouter un suffixe constant à chaque fin de ligne d'un fichier. Cela , j'y arrive.
Mais je voudrai aller plus loin en faisant cela pour un répertoire donnée ( qui pourra être mis en dur dans le script) ainsi que tous les fichiers qui seront de types .txt

Il faudrait que les anciens fichiers soient effacés, et que les nouveaux soient dans un répertoire donné.

Pour résumer :

1- j'ai 15 fichiers .txt dans le répertoire c:\TEMP\INPUT (défini dans le VBS qui ne changera jamais)
2- j'ajoute par le vbs ci- dessous un suffixe (défini dans le VBS qui ne changera jamais)
3- Déplacer les nouveaux fichiers dans le répertoire c:\TEMP\OUTPUT (défini dans le VBS qui ne changera jamais)
4- effacer les fichiers tous les fichiers *.txt du c:\TEMP\ÌNPUT
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 const ficlu = "c:\lgo\fichier_original.txt" const ficecrit = "c:\lgo\fichier_sortie.txt" const carac = "ajout test suffixe" ' caractère à mettre en bout de ligne Set oFso = CreateObject("Scripting.FileSystemObject") if not ofso.fileexists(ficlu) then _ msgbox "fichier non trouvé",, ficlu : wscript.quit Const ForReading = 1 const ForWriting = 2 Const TristateTrue = -1 ' Unicode Set fs = oFso.OpenTextFile(ficecrit,ForWriting,true) fic= oFSO.GetFile(ficlu).path Set fl = oFso.OpenTextFile(fic,ForReading, TristateTrue) while Not fl.AtEndOfStream lig = fl.readline fs.writeline (lig & carac) Wend fl.Close : fs.close
D'avance, merci de toute votre aide au combien précieuse :)

Pour traiter tous les fichiers, essaie avec ce

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
  Option Explicit
 
  'Const  ficlu    = "c:\lgo\fichier_original.txt"
  'Const  ficecrit = "c:\lgo\fichier_sortie.txt"
  Const  chars    = " =>ajout test suffixe" '       caractère à mettre en bout de ligne
  Const ForReading = 1, ForWriting = 2, TristateTrue  = -1     ' Unicode
  Const DossierSource ="C:\TEMP\INPUT", DossierCible = "C:\TEMP\OUTPUT\"
  Dim lig, fic, oFSO, fs, oFolder, oFich, fl
 
    Set oFso = CreateObject("Scripting.FileSystemObject")
 
    Set oFolder = oFSO.GetFolder(DossierSource)
 
    If oFolder.Files.Count = 0 Then 
        MsgBox "Aucun fichier trouvé dans " & DossierSource
        Wscript.Quit
    End If
    For Each oFich In oFolder.Files 
      fic = oFSO.GetFile(oFich).Path
      If LCase(oFSO.GetExtensionName(fic)) = "txt" Then
          Set fl = oFso.OpenTextFile(fic,ForReading, TristateTrue)
          Set fs = oFso.OpenTextFile(DossierCible & oFich.Name, ForWriting, True)
          While Not fl.AtEndOfStream
             lig = fl.readline
             fs.writeline (Trim(lig) & chars)
          Wend
          fl.Close  : fs.close
          oFSO.DeleteFile(oFSO.GetFile(fic)), True
      End If 
    Next
    MsgBox "Terminé"

30/03/2018, 17h27
PeterMac62

Merci beaucoup pour la proposition.

Par contre, j'ai testé plusieurs fois avec différents répertoire,et le script vbs me génère les fichiers un répertoire au dessus du répertoire de sortie....

test 1 : répertoire d'entrée c:\TEMP\IN *** répertoire de sortie c:\TEMP\out *** les fichiers sont générés dans c:\TEMP
test 2 : répertoire d'entrée c:\TEMP\IN *** répertoire de sortie c:\TEMP\OUT\OUT1\OUT2\OUT3 *** les fichiers sont générés dans c:\TEMP\OUT\OUT1\OUT2

étrange :)

Alors là c'est vraiment bizarre comme comportement du script !!!!!!!!!!!

Pourtant, pour moi cela marche très bien !
Essaie alors avec le script modifié comme dans ce

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
  Option Explicit
 
  'Const  ficlu    = "c:\lgo\fichier_original.txt"
  'Const  ficecrit = "c:\lgo\fichier_sortie.txt"
  Const  chars    = " =>ajout test suffixe" '       caractère à mettre en bout de ligne
  Const ForReading = 1, ForWriting = 2, TristateTrue  = -1     ' Unicode
  Const DossierSource ="C:\TEMP\INPUT\", DossierCible = "C:\TEMP\OUTPUT\"
  Dim LigneLue, sFileName, oFSO, Fichier_De_Sortie, oFolder, oFich, Fichier_A_Lire
  Set oFso = CreateObject("Scripting.FileSystemObject")
 
  ' Appel de Traite_Fichiers
  Call Traite_Fichiers(DossierSource, DossierCible, chars)
  ' Pour informer que le traitement est terminé
  MsgBox "Terminé" 
'=================================================  
Sub Traite_Fichiers(SrcFolder, DestFolder, StrToAdd)  
    If Not oFSO.FolderExists(DestFolder) Then oFSO.CreateFolder(DestFolder)
 
    Set oFolder = oFSO.GetFolder(SrcFolder)
    If oFolder.Files.Count = 0 Then 
        MsgBox "Aucun fichier à traiter dans : " & SrcFolder
        Wscript.Quit
    End If
    For Each oFich In oFolder.Files 
      sFileName = oFSO.GetFile(oFich.Path) 
      If LCase(oFSO.GetExtensionName(sFileName)) = "txt" Then
          Set Fichier_A_Lire = oFso.OpenTextFile(sFileName,ForReading, TristateTrue)
          Set Fichier_De_Sortie = oFso.OpenTextFile(DestFolder & oFich.Name, ForWriting, True)
          While Not Fichier_A_Lire.AtEndOfStream
             LigneLue = Fichier_A_Lire.ReadLine
             Fichier_De_Sortie.WriteLine RTrim(LigneLue) & StrToAdd
          Wend
          Fichier_A_Lire.Close  : Fichier_De_Sortie.Close
          oFSO.DeleteFile(oFSO.GetFile(sFileName)), True
      End If 
    Next
End Sub

30/03/2018, 22h54
ProgElecT

Salut

Citation:

Envoyé par PeterMac62

test 1 : répertoire d'entrée c:\TEMP\IN *** répertoire de sortie c:\TEMP\out *** les fichiers sont générés dans c:\TEMP
test 2 : répertoire d'entrée c:\TEMP\IN *** répertoire de sortie c:\TEMP\OUT\OUT1\OUT2\OUT3 *** les fichiers sont générés dans c:\TEMP\OUT\OUT1\OUT2

Const DossierSource ="C:\TEMP\INPUT", DossierCible = "C:\TEMP\OUTPUT\", personnellement je n'ai jamais vue de constantes s'incrémenter.

Pour moi, PeterMac62 n'a pas sut adapter ton code l_autodidacte.

Reste à savoir s'il parvient à le faire avec le dernier posté.

Si après les remarques de ProgElecT (Salut) et ce

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
  Option Explicit
 
 
  Const  chars    = " =>ajout test suffixe" '       caractères à mettre en bout de ligne
  Const ForReading = 1, ForWriting = 2, TristateTrue  = -1     ' Unicode
 
  Dim LigneLue, sFileName, oFSO, Fichier_De_Sortie, oFolder, oFich, Fichier_A_Lire, DossierSrc, DossierCible
 
  DossierSrc = "C:\TEMP\INPUT"
  DossierCible = "C:\TEMP\OUTPUT"
  Set oFso = CreateObject("Scripting.FileSystemObject")
 
  ' Appel de Traite_Fichiers
  Call Traite_Fichiers(DossierSrc, DossierCible, chars)
  ' Pour informer que le traitement est terminé
  MsgBox "Terminé"
 
'=================================================  
Sub Traite_Fichiers(SrcFolder, DestFolder, StrToAdd)  
    If Not oFSO.FolderExists(DestFolder) Then CreerDossiers(DestFolder)
    DestFolder = AddDirSep(DestFolder)
    Set oFolder = oFSO.GetFolder(SrcFolder)
    If oFolder.Files.Count = 0 Then 
        MsgBox "Aucun fichier à traiter dans : " & SrcFolder
        Wscript.Quit
    End If
    For Each oFich In oFolder.Files 
      sFileName = oFich.Path
      If LCase(oFSO.GetExtensionName(sFileName)) = "txt" Then
          Set Fichier_A_Lire = oFso.OpenTextFile(sFileName,ForReading, TristateTrue)
          Set Fichier_De_Sortie = oFso.OpenTextFile((DestFolder) & oFich.Name, ForWriting, True)
          While Not Fichier_A_Lire.AtEndOfStream
             LigneLue = Fichier_A_Lire.ReadLine
             Fichier_De_Sortie.WriteLine RTrim(LigneLue) & StrToAdd
          Wend
          Fichier_A_Lire.Close  : Fichier_De_Sortie.Close
          oFSO.DeleteFile(oFSO.GetFile(sFileName)), True
      End If 
    Next
End Sub
'=============================
Function CreerDossiers(sFolderName)
    ' Crée un ou plusieurs sous-dossiers
    Dim TB, Ind, NewFolder, oFold
    If Right(sFolderName, 1) ="\" Then sFolderName = Left(sFolderName, Len(sFolderName) - 1)
    TB = Split(sFolderName, "\")
    NewFolder = TB(0) & "\"
 
    If UBound(TB) >= 1 Then
       For Ind = 1 To UBound(TB)
          NewFolder = NewFolder & TB(Ind) & "\"
          If Not oFSO.FolderExists(NewFolder) Then _
          oFSO.CreateFolder(NewFolder)
       Next
    Else
       If Not oFSO.FolderExists(sFolderName) Then 
           Set oFold = oFSO.CreateFolder(sFolderName)
           NewFolder = oFold.Path 
       End If
    End If
    If oFSo.FolderExists(sFolderName) Then NewFolder = sFolderName
    CreerDossiers = NewFolder
End Function
'=============================
Function AddDirSep(strIN)
  ' Ajoute le caractère \ à la fin du nom du sous-dossier
    If Right(strIN, 1) <> "\" Then 
        AddDirSep = strIN & "\"
    Else
        AddDirSep = strIN
    End if
End Function

tu as toujours un problème avec le script, il faut revoir ta saisie et la façon dont tu as adapté le code.
Pour moi, tout est OK que ce soit avec le 1er, le 2nd ou ce 3ème code.

Avec ce code, tu n'as plus qu'à renseigner les 2 variables : DossierSRC et DossierCible avec les chemins corrects avec ou sans le caractère \ à la fin , et tout ira bien(enfin je l'espère pour toi).

04/04/2018, 09h59
PeterMac62

Bonjour et merci à tous.

Le dernier script fonctionne parfaitement :)

En tout cas, cela est parfaitement fonctionnel, donc MERCI à tous.... :D