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
Dim Data,fso,Ws,bWrite,File,LogFile,Line,Lines,Copyright,Titre
Titre = "Traitement des fichiers de type texte"
Copyright = " © Hackoo 2014"
Set Ws = CreateObject("wscript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")
LogFile = Left(Wscript.ScriptFullName,InstrRev(Wscript.ScriptFullName, ".")) & "txt"
If fso.FileExists(LogFile) Then
fso.DeleteFile LogFile
end If
For each File in FSO.GetFolder(Parcourir_Dossier()).Files
If UCase(fso.GetExtensionName(File)) = "TXT" Then
Data = ReadFileText(File)
bWrite = False
Lines = Split(Data,vbCrLf)
For Each Line In Lines
If Len(Line) <> 129 And Not Line = "" Then
bWrite = False
Exit For
Else
If Len(Line) = 129 And Not Line = "" Then
bWrite = True
End if
End if
Next
If bWrite = True Then
WriteLog DblQuote(File.Name) & " ==> est OK",LogFile
Else
WriteLog DblQuote(File.Name) & " ==> ERREUR ",LogFile
End if
End if
Next
If fso.FileExists(LogFile) Then
ws.Run LogFile,1,False
Else
Ws.popup "Il n'y a aucun fichier de type texte dans ce dossier ","3",Titre & Copyright,VbCritical
Wscript.Quit
end If
'****************************************************************************************************
Function Parcourir_Dossier()
Dim objShell,objFolder
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(0,"Veuillez choisir un dossier pour le traitement des fichiers de type texte "& Copyright,1,"c:\Programs")
If objFolder Is Nothing Then
Wscript.Quit
End If
Parcourir_Dossier = objFolder.self.path
end Function
'************************************************************************************************
Function ReadFileText(sFile)
Dim objFSO,oTS,sText
Set objFSO = CreateObject("Scripting.FileSystemObject")
If Not objFSO.FileExists(sFile) Then
MsgBox "ERREUR CRITIQUE " & VbCrLF & "Le fichier "& DblQuote(sFile) & " n'existes pas !",VbCritical,"ERREUR CRITIQUE"
Wscript.Quit
Else
Set oTS = objFSO.OpenTextFile(sFile)
sText = oTS.ReadAll
oTS.close
set oTS = nothing
Set objFSO = nothing
ReadFileText = sText
End if
End Function
'***********************************************************************************************
Sub WriteLog(strText,LogFile)
Dim fs,ts
Const ForAppending = 8
Set fs = CreateObject("Scripting.FileSystemObject")
Set ts = fs.OpenTextFile(LogFile,ForAppending,True)
ts.WriteLine strText
ts.Close
End Sub
'************************************************************************************************
Function DblQuote(Str)
DblQuote = Chr(34) & Str & Chr(34)
End Function
'********************************************************************************************** |
Partager