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 |
Partager