Accueil

 

Ouverture d'un fichier séquentiel Lecture d'un fichier séquentiel Ecriture dans un fichier séquentiel Export d'un champ Transforme ; en , Visualisation de fichiers séquentiels Concaténation de fichiers CSV

Open Input # Line Input # var=Input(n,#) Eof() Print #

Dans un fichier séquentiel, les enregistrements sont  séparés par les code ASCII 10 et 13.
Les fichiers séquentiels ont un caractère universel; Ils sont reconnus par tous les logiciels.

Ouverture d'un fichier séquentiel

Open nom_fichier For Input/Output As #no_fichier

L'ouverture d'un fichier séquentiel se fait en lecture ou en écriture avec Open.

Open "X.TXT" For Input As #1       ' ouverture en lecture
Open "X.TXT" For Output As #2     ' ouverture en écriture
Open "X.TXT" For Append As #1    ' ajout en fin de fichier

Lecture d'un fichier séquentiel

Line Input #no_fichier,variable
Input #no_fichier,variable
Eof(no_fichier)
variable=Input(nb_caractères, #no_fichier)

-Avec Input #, les ',' sont considérés comme séparateurs.
-Avec Line Input #, les caractères ',' ne sont pas considérés comme des séparateurs. Seuls les codes 13 et 10 sont condidérés comme séparateurs.
-La fin de fichier est donnée par la fonction Eof(no_fichier)
-La lecture caractère par caractère d'un fichier séquentiel se fait avec l'instruction Input(nb_caractères, #no_fichier)

Sur cet exemple, nous choisissons un fichier avec GetOpenFileName() et nous l'affichons dans une zone de texte
du formulaire nommée Texte (MultiLine=True)

Private Sub B_dossier_Click()
  nf = Application.GetOpenFilename("Fichiers Txt,*.txt")
  If Not nf = False Then
    Open nf For Input As #1
    MonTexte = ""
    Do While Not EOF(1)
      Line Input #1, ligne
      MonTexte = MonTexte & ligne & Chr(13)
    Loop
    Close #1
    Me.Texte = MonTexte
  End If
End Sub

Ecriture dans un fichier séquentiel

Print #,no_fichier,expression

L'écriture d'un enregistrement se fait avec PRINT #,no_fichier,expression

Export d'un champ sous forme de fichier Txt avec le séparateur ;

ExportChamp

Sub ExportTxtChamp()
  repertoire = ThisWorkbook.Path
  Open repertoire & "\x.txt" For Output As #1
  Set champ = [C1].CurrentRegion
  For lig = 1 To champ.Rows.Count
    ligne = ""
    For col = 1 To champ.Columns.Count
      ligne = ligne & champ.Cells(lig, col) & ";"
    Next col
    Print #1, Left(ligne, Len(ligne) - 1)
  Next lig
  Close #1
End Sub

Résultat

Nom;Ville;Code;salaire
Dupont;Paris;AAA;3500
Martin;Lyon;BBB;3600
Zoe;Paris;CCC;3700

Avec chaînes de caractères entre guillemets

Si les chaînes contiennent des séparateurs (;), il faut les encadrer par des guillemets:

"Nom";"Ville";"Code";"salaire"
"Dupont";"Paris";"AAA";3500
"Martin";"Lyon";"BBB";3600
"Zoe";"Paris;Lyon";"CCC";3700

Sub ExportTxtChamp2()
  repertoire = ThisWorkbook.Path
  Open repertoire & "\x.txt" For Output As #1
  Set champ = [C1].CurrentRegion
  For lig = 1 To champ.Rows.Count
    ligne = ""
    For col = 1 To champ.Columns.Count
      If IsNumeric(champ.Cells(lig, col)) Then
        ligne = ligne & champ.Cells(lig, col) & ";"
      Else
        ligne = ligne & Chr(34) & champ.Cells(lig, col) & Chr(34) & ";"
      End If
    Next col
    Print #1, Left(ligne, Len(ligne) - 1)
  Next lig
  Close #1
End Sub

Ecrit dans un fichier texte avec alignement des colonnes

EcritFS

La largeur des colonnes du fichier texte est basée sur la largeur des colonnes du fichier excel.

Sub ExportTxtChamp()
  repertoire = ThisWorkbook.Path
  Open repertoire & "\essai.txt" For Output As #1
  Set champ = [B1].CurrentRegion
  Dim lg(): ReDim lg(1 To champ.Columns.Count)
  For i = 1 To champ.Columns.Count
     lg(i) = champ.Cells(1, i).Width / 5
  Next i
  For lig = 1 To champ.Rows.Count
    ligne = ""
    For col = 1 To champ.Columns.Count
      ligne = ligne & champ.Cells(lig, col).Text
      If lg(col) - Len(champ.Cells(lig, col).Text) > 0 Then
         ligne = ligne & String(lg(col) - Len(champ.Cells(lig, col).Text), " ") & " "
      Else
         MsgBox "la colonne:" & col & " n'est pas assez large"
         Stop
     End If
  Next col
  Print #1, Left(ligne, Len(ligne) - 1)
  Next lig
  Close #1
End Sub

Transforme les ; en ,

Sub transf ()
  nf = InputBox("Nom fichier?")
  Open nf For Input As #1
  Open "c:\x.txt" For Output As #2
  Do While Not EOF(1)
    c = Input(1, #1)
    If c = ";" Then
      c = ","
    End If
    Debug.Print c
    Print #2, c;
  Loop
  Close #1, #2
End Sub

Suppression de la première ligne d'un fichier séquentiel

rep = ThisWorkbook.Path
Open rep & "\essai.txt" For Input As #1
Open rep & "\sortie.txt" For Output As #2
'--1er fichier
Line Input #1, ligne
Do While Not EOF(1)
  Line Input #1, ligne
  Print #2, ligne
Loop
Close #1, #2

Suppression des lignes commençant par xyz

Sub SupLignes()
  code = "xxx" ' lignes commençant par xxx
  rep = ThisWorkbook.Path
  Open rep & "\essai.txt" For Input As #1
  Open rep & "\sortie.txt" For Output As #2
  Do While Not EOF(1)
    Line Input #1, ligne
    If Left(ligne, Len(code)) <> code Then
       Print #2, ligne
    End If
  Loop
  Close #1, #2
  Kill rep & "\essai.txt"
  Name rep & "\sortie.txt" As rep & "\essai.txt"
End Sub

Remplacement d'un code dans un fichier séquentiel

Sub LectEcrFichSeq()
  ' On remplace le code 11 par 99 en position 10,11

  '50 99999 11 AAAAAA
  '50 99999 12 BBBBBB
  '50 99999 11 CCCCCC
  '50 99999 13 DDDDDD

  rep = ThisWorkbook.Path
  nomfich = "Monfich"
  Open rep & "\" & nomfich & ".txt" For Input As #1
  Open rep & "\" & nomfich & "x.txt" For Output As #2
  Do While Not EOF(1)
    Line Input #1, ligne
    If Mid(ligne, 10, 2) = "11" Then
       Mid(ligne, 10, 2) = "99"
    End If
    Print #2, ligne
  Loop
  Close #1, #2
  Kill rep & "\" & nomfich & ".txt"
  Name rep & "\" & nomfich & "x.txt" As rep & "\" & nomfich & ".txt"
End Sub

Visualisation de fichiers .txt

Pour obtenir la liste des fichiers Txt du répertoire choisi :

VisuTxt

Private Sub UserForm_Initialize()
  Me.Dossier = CurDir()
  Me.ChoixFichier.Clear
  nf = Dir("*.txt") ' premier
  Do While nf <> ""
    Me.ChoixFichier.AddItem nf
    nf = Dir ' suivant
  Loop
End Sub

Visualise le contenu . Modifier ScrollBars et Multi-Line :

Private Sub ChoixFichier_Click()
   Open Me.ChoixFichier For Input As #1
   MonTexte = ""
   Do While Not EOF(1)
     Line Input #1, ligne
     MonTexte = MonTexte & ligne & Chr(13)
   Loop
   Close #1
   Me.Texte = MonTexte
End Sub

Private Sub b_dossier_Click()
  If Val(Application.Version) >= 10 Then
    With Application.FileDialog(msoFileDialogFolderPicker)
      .InitialFileName = CurDir() 'ActiveWorkbook.Path & "\"
      .Show
      If .SelectedItems.Count > 0 Then
        Me.Dossier = .SelectedItems(1)
        ChDir Me.Dossier
      Else
        Me.Dossier = ""
      End If
      UserForm_Initialize
   End With
  End If
End Sub

Concaténation de fichiers CSV

Sur cet exemple, on ajoute des fichiers .CSV

ChDir ThisWorkbook.Path
Open "classeur1.csv" For Input As #1
Open "classeur5.csv" For Output As #2
'--1er fichier
Do While Not EOF(1)
  Line Input #1, ligne
  Print #2, ligne
Loop
Close #1
'-- 2e fichier
Open "classeur2.csv" For Input As #1
Line Input #1, ligne             ' 1ere ligne
Do While Not EOF(1)
   Line Input #1, ligne
   Print #2, ligne
Loop
Close #1, #2

Import de plusieurs fichiers txt dans un classeur

Sub Import()
  nf = Dir("import*.txt") ' premier fichier
  i = 1
  Do While nf <> ""
     Open "import.txt" For Input As #1
     If témoinTitre Then Line Input #1, ligne
     Do While Not EOF(1)
       Line Input #1, ligne
       temp = Split(ligne, vbTab)
       Cells(i, 1).Resize(1, UBound(temp)) = temp
       i = i + 1
    Loop
    Close #1
    nf = Dir ' fichier suivant
    témoinTitre = True
  Loop
End Sub

Autre solution

Sub Import2()
  fichieractuel = ThisWorkbook.Name
  Cells.ClearContents
  nf = Dir("import*.txt") ' premier fichier
  i = 1
  Do While nf <> ""
    Workbooks.OpenText Filename:=nf, DataType:=xlDelimited, Tab:=True
    If témoinTitre Then
      [A1].CurrentRegion.Select
      Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Copy _
         Workbooks(fichieractuel).Sheets(1).[A65000].End(xlUp).Offset(1, 0)
     Else
       [A1].CurrentRegion.Copy   Workbooks(fichieractuel).Sheets(1).[A1]
    End If
    ActiveWorkbook.Close
    nf = Dir ' fichier suivant
    témoinTitre = True
   Loop
End Sub

Compteur

Sub compteur()
  repertoire = ThisWorkbook.Path & "\"
  nf = "toto.txt"
  chemin = repertoire & nf
  If Dir(chemin) <> "" Then
    Open chemin For Input As #1
    Input #1, temp
    Close #1
  Else
    temp = 0
  End If
  Open chemin For Output As #1
  Print #1, temp + 1
  Close #1
  MsgBox temp
End Sub

Ouverture en mode Binary

Syntaxe:

Open Chemin For Binary As #Numéro
Get #numéro,position,tableau

Sub TestNBLignes()
  Dim Tbl() As Byte
  nf = "essai.txt"
  longueur = FileLen(nf)
  Open nf For Binary As #1
  ReDim Tbl(1 To longueur)
  Get #1, 1, Tbl
  Close #1
  For i = 1 To longueur
    If Tbl(i) = 13 Then n = n + 1
  Next i
  MsgBox n
End Sub

Combobox avec liste dans un fichier texte

Fichier Maliste.txt

1;description1
2;description2
3;description3
4;description4

Private Sub ComboBox1_DropButtonClick()
  Open "maliste.txt" For Input As #1
  Dim a()
  n = 0
  Do While Not EOF(1)
    Line Input #1, temp
    b = Split(temp, ";")
    n = n + 1
    ReDim Preserve a(1 To 2, 1 To n)
    a(1, n) = b(0)
    a(2, n) = b(1)
   Loop
   Close #1
   ComboBox1.List = Application.Transpose(a)
End Sub