' --------------------------------------------------------------------------------------------------------------- '
' Script de d�coupage des relev�s multicomptes en plusieurs relev�s monocompte 21-09-2010 Yann RAOUL '
' '
' UTILISATION : Indiquer le chemin complet du fichier source en param�tre de ce script entre guillemets : '
' '
' Exemple : script_decoupage_et_duplication_releves.vbs "C:\Suite Entreprise v2\AFB\MONRELEVE.EXT" '
' '
' Mise � jour 10-04-2014 : fusion du script de d�coupage avec le script de copie '
' D�sormais, le fichier de d�coupage peut copier les fichiers d�coup�s '
' Dans un (ou plusieurs) r�pertoire(s) '
' '
' --------------------------------------------------------------------------------------------------------------- '
' ############## PARAMETRES DU SCRIPT ##############
blnSuppressionFichierSource = True ' Si cette valeur est � False, on ne supprime pas le fichier source
blnEcritureLog = False ' Permet d'�crire un fichier de trace de l'ex�cution de ce script
CheminFichierLog = "C:\Suite Entreprise v2\LogDecoupageReleves.txt" ' Chemin o� est positionn� la log de ce script
CheminsDestinationCopie = "D:\TEST1;D:\TEST2" ' Chemin o� seront copi�s les fichiers d�coup�s
' #################################################
ecrit_log_debut_fichier()
' 0/ R�cup�ration du fichier source
ecrit_log("R�cup�ration du fichier source")
Set oArgs=WScript.Arguments
if oArgs.count = 0 then
ecrit_log_fin_fichier("ERREUR : Veuillez indiquer un nom de fichier en param�tre de ce script.")
WScript.Quit
end if
CheminFichierSource = oArgs(0)
CheminFichierRacine = UCase(mid(CheminFichierSource, 1, len(CheminFichierSource)-4)) ' Le chemin qui servira de racine pour les relev�s en sortie
ecrit_log("R�cup�ration OK => Chemin Fichier Source = " & CheminFichierSource)
' 1/ Contr�le de l'extension du relev�
ecrit_log("Contr�le de l'extension du relev�")
if UCase(mid(CheminFichierSource, len(CheminFichierSource)-3, 4)) <> ".EXT" then
ecrit_log_fin_fichier("ERREUR : Probl�me d'extension de relev�, le relev� n'est pas un fichier .EXT")
end if
ecrit_log("Extension OK")
' 2/ D�claration des variables
ecrit_log("D�claration des variables")
dim ComptesTrouves ' liste des comptes trouv�s dans le fichier de relev�, splitt� par des ";"
Dim filesys, text, readfile, LigneFichierSource
Set filesys = CreateObject("Scripting.FileSystemObject")
Set readfile = filesys.OpenTextFile(CheminFichierSource, 1, false)
ecrit_log("D�claration OK")
' 3/ Balayage des lignes du fichier source
ecrit_log("Balayage des lignes du fichier source")
intNumeroLigne = 0
intNombreFichiersCrees = 0
intNombreFichiersSupprimes = 0
dim listeFichiersDecoupes
set listeFichiersDecoupes = CreateObject("System.Collections.ArrayList")
Do while readfile.AtEndOfStream = False
intNumeroLigne = intNumeroLigne + 1
LigneFichierSource = readfile.ReadLine ' La ligne en cours
If Len(LigneFichierSource) <> 120 Then
ecrit_log_fin_fichier("ERREUR : La ligne " & intNumeroLigne & " du fichier " & CheminFichierSource & " ne fait pas 120 caract�res de long")
End If
NomFichierReleve = CheminFichierRacine + "-" + RecupCompte(LigneFichierSource) + ".EXT"
If listeFichiersDecoupes.IndexOf(NomFichierReleve, 0) = -1 Then
listeFichiersDecoupes.Add NomFichierReleve
End If
select case(mid(LigneFichierSource,1, 2)) ' Selon le d�but de la ligne
case "01": ' -------------------------------------------------------- DEBUT DU RELEVE -------------------------------------------------------- '
if IsNouveauCompte(RecupCompte(LigneFichierSource)) Then ' C'est un nouveau compte, on contr�le l'existence du fichier => Si oui, on le supprime pour �viter que des relev�s se m�langent
If filesys.FileExists(NomFichierReleve) Then
ecrit_log("Le relev� " & NomFichierReleve & " est pr�sent sur le poste avant d�coupage => Suppression du fichier")
intNombreFichiersSupprimes = intNombreFichiersSupprimes + 1
filesys.DeleteFile(NomFichierReleve)
end if
intNombreFichiersCrees = intNombreFichiersCrees + 1
end if
AjouterLigne LigneFichierSource, NomFichierReleve
case "04": ' -------------------------------------------------------- CONTENU DU RELEVE -------------------------------------------------------- '
NomFichierReleve = CheminFichierRacine + "-" + RecupCompte(LigneFichierSource) + ".EXT"
AjouterLigne LigneFichierSource, NomFichierReleve
case "05": ' -------------------------------------------------------- CONTENU DU RELEVE COMPLEMENTAIRE -------------------------------------------------------- '
NomFichierReleve = CheminFichierRacine + "-" + RecupCompte(LigneFichierSource) + ".EXT"
AjouterLigne LigneFichierSource, NomFichierReleve
case "07": ' --------------------------------------------------------- FIN DU RELEVE -------------------------------------------------------- '
NomFichierReleve = CheminFichierRacine + "-" + RecupCompte(LigneFichierSource) + ".EXT"
AjouterLigne LigneFichierSource, NomFichierReleve
case else:
ecrit_log_fin_fichier("ERREUR : la ligne " & intNumeroLigne & " du relev� " & CheminFichierSource & " ne poss�de pas le bon pr�fixe. Celui-ci doit �tre 01, ou 04, ou 07. Or celui-ci vaut " & mid(LigneFichierSource,1, 2))
end select
loop
readfile.close
ecrit_log("Balayage OK => " & intNombreFichiersCrees & " fichiers cr��s, " & intNombreFichiersSupprimes & " supprim�s")
If CheminsDestinationCopie <> "" Then
ecrit_log("Copie des fichiers d�coup�s")
For Each fichierDecoupe in listeFichiersDecoupes
CopieFichier fichierDecoupe, CheminsDestinationCopie
Next
End If
' --------------------------------------------------------------------------------------------------------------- '
' FIN DU SCRIPT
' --------------------------------------------------------------------------------------------------------------- '
' On supprime le fichier d'origine apr�s traitement de toutes les lignes de celui-ci
If filesys.FileExists(CheminFichierSource) Then
If blnSuppressionFichierSource = True Then
ecrit_log("Suppression du fichier " & CheminFichierSource)
filesys.deletefile(CheminFichierSource)
End If
End If
ecrit_log_fin_fichier("")
WScript.Quit
' --------------------------------------------------------------------------------------------------------------- '
' FONCTIONS
' --------------------------------------------------------------------------------------------------------------- '
sub ecrit_log_debut_fichier()
ecrit_log("-----------------------------------------------------------")
ecrit_log("D�but du script")
End Sub
sub ecrit_log(Contenu)
If blnEcritureLog = False Then
Exit Sub
End If
DebutLigne = Date() & " " & Time() & " => "
Contenu = DebutLigne + Contenu
dim FSO, f
Set FSO = CreateObject("Scripting.FileSystemObject")
Set f = FSO.OpenTextFile(CheminFichierLog, 8, True)
f.Write( Contenu & VbCrLf )
f.Close
end Sub
sub ecrit_log_fin_fichier(Contenu)
if Contenu <> "" Then
ecrit_log(Contenu)
End If
ecrit_log("Script OK")
ecrit_log("Fin du script")
ecrit_log("-----------------------------------------------------------")
WScript.Quit
End Sub
' Ajoute la ligne pass�e en param�tre au fichier pass� en param�tre
Sub AjouterLigne(LigneAAjouter, CheminFichier)
dim FSO, f
Set FSO = CreateObject("Scripting.FileSystemObject")
If filesys.FileExists(CheminFichier) Then
' Fichier d�j� existant
Else
if CheminFichier <> CheminFichierLog Then ' Nouveau fichier, on l'inscrit en log
ecrit_log("Cr�ation du fichier " & CheminFichier)
End If
End If
Set f = FSO.OpenTextFile(CheminFichier, 8, True)
f.Write( LigneFichierSource & VbCrLf )
f.Close
end Sub
' R�cup�re le compte de la ligne en cours
Function RecupCompte(ligneEnCours)
RecupCompte = mid(ligneEnCours, 3, 5) + mid(ligneEnCours, 12, 5) + mid(ligneEnCours, 22, 11)
end Function
' Recherche dans l'array des comptes si celui-ci a d�j� �t� cr��
function IsNouveauCompte(Compte)
ComptesExistants = Split(ComptesTrouves, ";")
for each CompteEnCours in ComptesExistants
if Compte = CompteEnCours then
IsNouveauCompte = false
exit function
end if
next
IsNouveauCompte = true
' Ajout du nouveau compte dans la liste des comptes trouv�s
ComptesTrouves = ComptesTrouves + Compte + ";"
Exit Function
End Function
' ----------------------------------------------------
'
' Sub de copie du fichier
'
' Entr�es : - le (ou les) chemin(s) de fichier destination
'
' Note : si plusieurs chemin de destination sont d�finis, il faut les s�parer par des ;
' Exemple : "C:\abc.txt;C:\bcd.txt"
'
' ----------------------------------------------------
Sub CopieFichier(strCheminFichierDest)
Source = oArgs(0)
Destin = split(strCheminFichierDest,";")
Set objOFS = CreateObject("Scripting.FileSystemObject")
'
' On boucle sur les fichiers de destination
'
For i = 0 to UBound(Destin)
If (objOFS.FileExists(Source)) Then
objOFS.CopyFile Source, Destin(i)
End If
Next
Set objOFS = Nothing
End Sub
' ----------------------------------------------------
'
' Sub de copie du fichier
'
' Entr�es : - le (ou les) chemin(s) de fichier destination
'
' Note : si plusieurs chemin de destination sont d�finis, il faut les s�parer par des ;
' Exemple : "C:\abc.txt;C:\bcd.txt"
'
' ----------------------------------------------------
Sub CopieFichier(strCheminFichierSource, strCheminFichierDest)
Set objOFS = CreateObject("Scripting.FileSystemObject")
Source = strCheminFichierSource
Destin = split(strCheminFichierDest,";")
'
' On boucle sur les fichiers de destination
'
For i = 0 to UBound(Destin)
If (objOFS.FileExists(Source)) Then
Set objFile = objOFS.GetFile(Source)
ecrit_log("Copie du fichier " & objOFS.GetFileName(objFile) & " dans " & Destin(i))
objOFS.CopyFile Source, Destin(i) & "\" & objOFS.GetFileName(objFile)
End If
Next
Set objOFS = Nothing
End Sub
' ----------------------------------------------------
'
' Sub de d�placement du fichier
'
' Entr�es : - le (ou les) chemin(s) de fichier destination
'
' Note : si plusieurs chemin de destination sont d�finis, il faut les s�parer par des ;
' Exemple : "C:\abc.txt;C:\bcd.txt"
'
' ----------------------------------------------------
Sub DeplaceFichier(strCheminFichierDest)
Source = CheminFichierSource
Destin = split(strCheminFichierDest,";")
Set objOFS = CreateObject("Scripting.FileSystemObject")
'
' On boucle sur les fichiers de destination
'
For i = 0 to UBound(Destin)
If (objOFS.FileExists(Source)) Then
objOFS.CopyFile Source, Destin(i)
End If
Next
Set Ftxt = objOFS.GetFile(CheminFichierSource)
Ftxt.delete
Set objOFS = Nothing
End Sub
' ----------------------------------------------------
'
' Sub de suppression du fichier
'
' Entr�e : - le chemin de fichier strCheminFichier
'
' ----------------------------------------------------
Sub SupprimeFichier(strCheminFichier)
Set FSO = CreateObject("Scripting.FileSystemObject")
'Suppression du fichier
Set Ftxt = fso.GetFile(strCheminFichier)
Ftxt.delete
End Sub
' ----------------------------------------------------
'
' Fonction de lecture du fichier
'
' Entr�e : - le fichier � lire
'
' Sortie : - la string du contenu du fichier
'
' ----------------------------------------------------
Function LireFichier(strCheminFichier)
' 1/ d�claration file system object
Dim fso
' 2/ instanciation
Set FSO = CreateObject("Scripting.FileSystemObject")
' 3/ on instancie le fichier texte
Set Ftxt = FSO.OpenTextFile(strCheminFichier)
' 4/ on parcoure chaque ligne du fichier texte
Do While Not Ftxt.AtEndOfStream
MaVariable = Ftxt.Readline
'....... <- votre code ici pour traiter chaque ligne
Loop
Ftxt.Close
End Function
' Fait du padding de string en input, voire exemple comment�
Function Lpad (MyValue, MyPadChar, MyPaddedLength)
Lpad = string(MyPaddedLength - Len(MyValue),MyPadChar) & MyValue
'msgbox(Lpad("1","0",6) & vbCrLf & Lpad("11","0",6))
End Function