Public Sub DecouperFichier()
'Version du 5 aout 2008 13:35
Dim CheminScriptActuel
Dim CheminFichierSource
Dim CheminFichierCible
Dim RacineNomFichierCible
Dim NomFichierCible
Dim MaLigne
Dim NumeroLigneFichierSource
Dim NumeroLigneFichierCible
Dim NumeroFichier
Dim MaLimite
Dim MonExtension
Dim objFSO
Dim objTextFichierSource
Dim objTextFichierCible
'Déclaration des constantes
Const ForReading = 1
Const ForWritting = 2
Const ForAppending = 8
CheminScriptActuel = Left(Wscript.scriptfullname, Len(Wscript.scriptfullname) - Len(Wscript.scriptname) - 1)
'CheminScriptActuel = "D:\PourSecurite"
'CheminFichierSource = InputBox("Entrez le chemin du fichier", "Chemin du répertoire", CheminScriptActuel & "\MonFichier.txt")
CheminFichierSource = InputBox("Entrez le chemin du fichier", "Chemin du répertoire", CheminScriptActuel & "\ALIZES_20080718171048.csv")
RacineNomFichierCible = InputBox("Entrez le chemin du fichier", "Chemin du répertoire", "ALIZES_20080718171048_")
MaLimite = InputBox("Entrez le chemin du fichier", "Chemin du répertoire", 65000)
MonExtension = InputBox("Entrez le chemin du fichier", "Chemin du répertoire", ".csv")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTextFichierSource = objFSO.OpenTextFile(CheminFichierSource, ForReading, True)
'Pour toutes les lignes du fichier
NumeroLigneFichierSource = 0
NumeroLigneFichierCible = 0
Do Until objTextFichierSource.AtEndOfStream
NumeroLigneFichierSource = NumeroLigneFichierSource + 1
DoEvents
'Lecture d une ligne du fichier source
MaLigne = objTextFichierSource.Readline 'Lecture et affichage de la ligne
'Si on est en train de lire la première ligne, on créé le premier fichier de sortie
If NumeroLigneFichierSource = 1 Then
NumeroFichier = 1
NomFichierCible = RacineNomFichierCible & NumeroFichier
CheminFichierCible = CheminScriptActuel & "\" & NomFichierCible & MonExtension
Set objTextFichierCible = objFSO.OpenTextFile(CheminFichierCible, ForWritting, True)
End If
'Ecriture de la ligne dans le fichier Cible
objTextFichierCible.WriteLine (MaLigne)
NumeroLigneFichierCible = NumeroLigneFichierCible + 1
'Si on a atteind la limite de la taille du fichier cible, on change de fichier
If NumeroLigneFichierCible >= MaLimite Then
objTextFichierCible.Close
NumeroLigneFichierCible = 0
NumeroFichier = NumeroFichier + 1
NomFichierCible = RacineNomFichierCible & NumeroFichier
CheminFichierCible = CheminScriptActuel & "\" & NomFichierCible & MonExtension
Set objTextFichierCible = objFSO.OpenTextFile(CheminFichierCible, ForWritting, True)
End If
Loop
objTextFichierSource.Close
Set objTextFichierSource = Nothing
Set objFSO = Nothing
objTextFichierCible.Close
Set objTextFichierCible = Nothing
End Sub
Lien vers le fichier : cliquez ici