IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)

FAQ Excel

FAQ ExcelConsultez toutes les FAQ

Nombre d'auteurs : 46, nombre de questions : 845, dernière mise à jour : 30 mars 2022 

 
OuvrirSommaireLa manipulation des fichiers textes

Cette solution scinde le fichier txt en 65 536 lignes par feuille.
65 536 correspond au nombre de lignes importées par feuille. Au delà de cette valeur, une nouvelle feuille est ajoutée et le compteur est réinitialisé.
vbTab (tabulation) est supposé être le séparateur de données pour les éléments de chaque ligne.

Vba
Sélectionnez
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

Une autre solution qui utilise le paramètre MaxRows de la méthode CopyFromRecordset afin de définir le nombre de lignes par feuille, lors de l'import.

Vba
Sélectionnez
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
Créé le 20 septembre 2008  par SilkyRoad
Vba
Sélectionnez
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
Créé le 20 septembre 2008  par SilkyRoad

La solution proposée ici utilise la méthode GetString.
Rs.GetString(adClipString, -1, ";", vbCrLf, "")

adClipString indique le format de la requête (choix unique).
-1 indique qu'il faut récupérer tous les enregistrements.
";" spécifie le délimiteur de colonnes.
vbCrLf spécifie le délimiteur d'enregistrements.
"" indique comment doivent être représentées les valeurs nulles.

Vba
Sélectionnez
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
Créé le 20 septembre 2008  par SilkyRoad

Cet exemple supprime les lignes 1, 3 et 10.
Les numéros de lignes doivent impérativement être spécifiés par ordre décroissant.

Vba
Sélectionnez
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
Créé le 18 novembre 2008  par SilkyRoad

Ouvrez votre fichier en mode binaire.
Par exemple, sur une base de 128 octects par groupe, vous pouvez utiliser :

Vba
Sélectionnez
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
Créé le 18 novembre 2008  par SilkyRoad

La première solution consiste à importer le fichier sur votre disque pour ensuite l'ouvrir.

Vba
Sélectionnez
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

La deuxième solution lit le fichier directement puis le charge dans un buffer texte :

Vba
Sélectionnez
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
Créé le 19 février 2009  par ThierryAIM

Les sources présentées sur cette page sont libres de droits et vous pouvez les utiliser à votre convenance. Par contre, la page de présentation constitue une œuvre intellectuelle protégée par les droits d'auteur. Copyright © 2009 Developpez Developpez LLC. Tous droits réservés Developpez LLC. Aucune reproduction, même partielle, ne peut être faite de ce site ni de l'ensemble de son contenu : textes, documents et images sans l'autorisation expresse de Developpez LLC. Sinon vous encourez selon la loi jusqu'à trois ans de prison et jusqu'à 300 000 € de dommages et intérêts.