Public Sub DecouperFichier()
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
Const ForReading = 1
Const ForWritting = 2
Const ForAppending = 8
CheminScriptActuel = Left(Wscript.scriptfullname, Len(Wscript.scriptfullname) - Len(Wscript.scriptname) - 1)
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)
NumeroLigneFichierSource = 0
NumeroLigneFichierCible = 0
Do Until objTextFichierSource.AtEndOfStream
NumeroLigneFichierSource = NumeroLigneFichierSource + 1
DoEvents
MaLigne = objTextFichierSource.Readline
If NumeroLigneFichierSource = 1 Then
NumeroFichier = 1
NomFichierCible = RacineNomFichierCible & NumeroFichier
CheminFichierCible = CheminScriptActuel & "\" & NomFichierCible & MonExtension
Set objTextFichierCible = objFSO.OpenTextFile(CheminFichierCible, ForWritting, True)
End If
objTextFichierCible.WriteLine (MaLigne)
NumeroLigneFichierCible = NumeroLigneFichierCible + 1
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