TUTOS.EU

Découper un fichier en morceaux

Découper un fichier suivant le nombre de lignes

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