Traiter une fichier .txt de plus de 65536 lignes !!!!

Sub Extraire()
Dim Repertoire As String, Fichier As String
Dim strFullName As Variant
Dim Cn As Object, Rs As Object

'Sélection du ficher
strFullName = Application.GetOpenFilename("Fichiers textes (*.txt),*.txt", , _
"Sélectionnez un fichier :")

'On sort si aucun fichier n'est sélectionné
If strFullName = False Then Exit Sub

Application.ScreenUpdating = False
Fichier = Dir(strFullName)
Repertoire = Left(strFullName, Len(strFullName) - (Len(Fichier) + 1))


'Connection
Set Cn = CreateObject("ADODB.Connection")
Cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Repertoire & ";" & _
"Extended Properties=""text;HDR=Yes;FMT=Delimited"""

'Requete
Set Rs = CreateObject("ADODB.Recordset")
Rs.Open "SELECT * FROM [" & Fichier & "]", Cn, 3, 1, 1

'boucle sur le résultat de la requete
While Not Rs.EOF
'Ajout Feuille
Worksheets.Add
'Ecriture des données dans la feuille
'65536 spécifie le nombre de lignes par feuille(à toi de choisir le nombre)
ActiveSheet.Range("A1").CopyFromRecordset Rs, 65536
Wend

Rs.Close
Set Rs = Nothing
Cn.Close
Set Cn = Nothing
Application.ScreenUpdating = True
End Sub

Cliquez pour agrandir...

Date vanne TEMPERATURE HUILE STAT HYDRAU 146T 1ère PRESSE.Brute (degC) TEMPERATURE HUILE STAT HYDRAU 146T 1ère PRESSE.Brute (degC) PRESSION REFOULEMENT POMPE 146T.Brute (BAR) DEBIT REFOULEMENT POMPE 146T.Brute (l/mn)
09/02/2010 13:00:16 69,771
09/02/2010 13:00:17 25,785 49,792 69,771
09/02/2010 13:00:20 25,785 49,792 69,771 261,32

Cliquez pour agrandir...

"09/02/2010 13:00:16 69" "771 "
"09/02/2010 13:00:17 25" "785 49" "792 69" "771 "
"09/02/2010 13:00:20 25" "785 49" "792 69" "771 261" "32 "

Cliquez pour agrandir...

Option Explicit

Sub ImportLargeFile()
Dim strFilePath As String, strFilename As String, vFullPath As Variant
Dim lngCounter As Long
Dim oConn As Object, oRS As Object, oFSObj As Object

vFullPath = Application.GetOpenFilename("Text Files (*.txt),*.txt", , "Fichier...")

If vFullPath = False Then Exit Sub
Application.ScreenUpdating = False

Set oFSObj = CreateObject("Scripting.FileSystemObject")
strFilePath = oFSObj.GetFile(vFullPath).ParentFolder.Path
strFilename = oFSObj.GetFile(vFullPath).Name

Set oConn = CreateObject("ADODB.CONNECTION")
oConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & strFilePath & ";" & _
"Extended Properties=""text;HDR=No;FMT=Delimited"""

Set oRS = CreateObject("AdoDb.Recordset")

oRS.Open "SELECT * FROM " & strFilename, oConn, 3, 1, 1
While Not oRS.EOF
Sheets.Add
ActiveSheet.Range("A1").CopyFromRecordset oRS, 65536
Wend
oRS.Close
oConn.Close
Application.ScreenUpdating = True
End Sub

Cliquez pour agrandir...