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