Sub Test()
    Extraction "C:\dossier\Nomfichier.txt", 65536, vbTab
End Sub
 
 
Sub Extraction(Fichier As String, _
     NbLignesParFeuille As Long, _
     Separateur As Variant)
 
    Dim Wb As Workbook
    Dim Counter As Double
    Dim Tableau() As String
    Dim i As Integer
    Dim ContenuLigne As String
 
    Application.ScreenUpdating = False
 
    Counter = 1
    Set Wb = Workbooks.Add(1)
 
    'Ouverture du fichier txt
    Open Fichier For Input As #1
        Do While Not EOF(1)
            If Counter > NbLignesParFeuille Then
                Wb.Worksheets.Add
                Counter = 1
            End If
 
            Line Input #1, ContenuLigne
            'découpe la chaine en fonction des espaces " "
            'le résultat de la fonction Split est stocké dans un tableau
            Tableau = Split(ContenuLigne, Separateur)
 
            'boucle sur le tableau pour extraire les données
            For i = 0 To UBound(Tableau)
                ActiveSheet.Cells(Counter, i + 1) = Tableau(i)
            Next i
 
            Counter = Counter + 1
        Loop
    Close #1
 
    Application.ScreenUpdating = True
    MsgBox "Opération terminée"
End Sub

Sub Extraction_V2()
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
    ActiveSheet.Range("A1").CopyFromRecordset Rs, 65536
Wend
 
Rs.Close
Set Rs = Nothing
Cn.Close
Set Cn = Nothing
Application.ScreenUpdating = True
End Sub

Sub importFichierTexte_ADO()
    Dim Rc As ADODB.Recordset
    Dim cn As String, Chemin As String, Fichier As String
    Dim i As Long
 
    Chemin = "C:\Documents and Settings\michel\dossier"
    Fichier = "monFichier.txt"
 
    cn = "Driver={Microsoft Text Driver (*.txt; *.csv)};" & _
        "Dbq=" & Chemin & ";Extensions=asc,csv,tab,txt"
 
    Set Rc = New ADODB.Recordset
    Rc.Open Source:="SELECT * FROM " & Fichier & _
        " WHERE NomChamp = 'x'", ActiveConnection:=cn
 
    If Not Rc.EOF Then
        'For i = 0 To Rc.Fields.Count - 1 'recuperation entetes
            'Cells(1, 1).Offset(0, i) = Rc.Fields(i).Name
        'Next
        Range("A2").CopyFromRecordset Rc
    End If
 
    Rc.Close
End Sub

Sub FeuilleExcel_VersFichierTexte()
    'Nécessite d'activer la référence
        'Microsoft ActiveX Data Objects 2.x Library
 
    Dim Rs As ADODB.Recordset
    Dim Fichier As String, Feuille As String
    Dim xConnect As String, xSql As String
    Dim i As Long
    Dim x As String
 
    Fichier = "C:\dossier\ClasseurFerme.xls"
    Feuille = "Feuil1"
 
    xConnect = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & _
            Fichier & ";" & _
            "Extended Properties=Excel 8.0;"
 
    xSql = "SELECT * FROM [" & Feuille & "$];"
 
    Set Rs = New ADODB.Recordset
    Rs.Open xSql, xConnect, adOpenForwardOnly, adLockReadOnly, adCmdText
 
    '--- récupération de la première ligne
    For i = 0 To Rs.Fields.Count - 1
        x = x & Rs.Fields(i).Name & ";"
    Next i
    '---
 
    'Création du fichier txt.
    'Si le fichier existe, les anciennes données seront écrasées.
    'Si le fichier n'existe pas , il sera créé automatiquement.
    Open "C:\essai.txt" For Output As #1
        'Ecriture de l'entête dans le fichier .txt
        Print #1, Left(x, Len(x) - 1) & vbCrLf;
        'Ecriture de la requête dans le fichier .txt
        Print #1, Rs.GetString(adClipString, -1, ";", vbCrLf, "")
    Close #1
 
    Rs.Close
    Set Rs = Nothing
End Sub

Option Explicit
Option Base 1
 
Sub SuppressionLignes()
    Dim objCol As New Collection
    Dim x As Integer, i As Integer
    Dim strLigne As String, Fichier As String
    Dim Tableau As Variant
 
    'Définit les lignes à supprimer, par
    'ordre décroissant impérativement !
    Tableau = Array(10, 3, 1)
    Fichier = "C:\monFichier.txt"
 
    x = FreeFile
    'Transfère des infos du fichier txt vers une collection.
    Open Fichier For Input As #x
        While Not EOF(x)
            Line Input #x, strLigne
            objCol.Add strLigne
        Wend
    Close #x
 
    'Suppression des lignes spécifiées dans la collection.
    For i = 1 To UBound(Tableau)
        If objCol.Count >= Tableau(i) Then _
            objCol.Remove Tableau(i)
    Next i
 
    'Transfère la collection vers le fichier txt.
    Open Fichier For Output As #x
        For i = 1 To objCol.Count
            Print #x, objCol(i)
        Next
    Close #x
 
    Set objCol = Nothing
End Sub

Dim lngPosistion As Long
Dim strLine As String
 
Open "C:\dossier\test.txt" For Binary As #1
    Do While lngPosistion < LOF(1)
        strLine = Input(128, #1)
        lngPosistion = Loc(1)
        Debug.Print strLine
    Loop
Close #1

Private Declare Function URLDownloadToFile Lib "urlmon" Alias _
        "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, _
        ByVal szFileName As String, ByVal dwReserved As Long, _
        ByVal lpfnCB As Long) As Long
 
Sub Telechargement()
    URLDownloadToFile 0, "http://www.passiblog.com/404.txt", "C:\404.txt" & ufile, 0, 0
End Sub

Option Explicit
 
Const scUserAgent = ""
Const INTERNET_OPEN_TYPE_DIRECT = 1
Const INTERNET_OPEN_TYPE_PROXY = 3
Const INTERNET_FLAG_RELOAD = &H80000000
 
Private Declare Function InternetOpen Lib "wininet" Alias "InternetOpenA" _
    (ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, _
    ByVal sProxyBypass As String, ByVal lFlags As Long) As Long
 
Private Declare Function InternetCloseHandle Lib "wininet" _
    (ByVal hInet As Long) As Integer
 
Private Declare Function InternetReadFile Lib "wininet" _
    (ByVal hFile As Long, ByVal sBuffer As String, ByVal lNumBytesToRead As Long, _
    lNumberOfBytesRead As Long) As Integer
 
Private Declare Function InternetOpenUrl Lib "wininet" Alias "InternetOpenUrlA" _
    (ByVal hInternetSession As Long, ByVal lpszUrl As String, _
    ByVal lpszHeaders As String, ByVal dwHeadersLength As Long, ByVal dwFlags As Long, _
    ByVal dwContext As Long) As Long
 
 
Sub Test()
    Dim hOpen As Long, hFile As Long
    Dim sBuffer As String
    Dim hRet As Long
 
    'Create a buffer for the file we're going to download
    sBuffer = Space(20000)
 
    'Create an internet connection
    hOpen = InternetOpen(scUserAgent, INTERNET_OPEN_TYPE_DIRECT, _
        vbNullString, vbNullString, 0)
 
    'Open the url
    hFile = InternetOpenUrl(hOpen, "http://www.passiblog.com/404.txt", _
        vbNullString, ByVal 0&, INTERNET_FLAG_RELOAD, ByVal 0&)
 
    'Lit le fichier > buffer
    InternetReadFile hFile, sBuffer, Len(sBuffer), hRet
 
    'clean up
    InternetCloseHandle hFile
    InternetCloseHandle hOpen
 
    '-- recupère la chaine lue
    Contents = Trim(sBuffer)
    Debug.Print Contents
End Sub