traitement fichier Text en VB6Résolu

Question

Bonjour, je dois faire un programme qui va lire un fichier Text, y extraire des valeurs en 5 catégories et les réécrire sous forme de colonne sur un autre fichier Text. 
J'arrive à ouvrir et lire le fichier Text, mais je ne capture que la dernier ligne du fichier, je n'arrive pas à capturer ligne par ligne et affiché le résultat. Je sais que pour afficher il faut que j'utilise un tableau.

Voilà exemple du fichier text que je dois lire avec normalement 5000 lignes, je doit lire les 1000 premier et les afficher dans un colonne dans l'autre fichier, les 1000 suivante dans une autre colonne ainsi de suite.
NAME BODY 
VAR_GLOBAL
AT %MW1000 : WORD := (384);
AT %MW1001 : WORD := (384);
AT %MW1002 : WORD := (384);
AT %MW1003 : WORD := (384);
AT %MW1004 : WORD := (384);
AT %MW1005 : WORD := (384);
AT %MW1006 : WORD := (384);
AT %MW1007 : WORD := (383);
AT %MW1008 : WORD := (383);
AT %MW1009 : WORD := (383);
AT %MW1010 : WORD := (383);
AT %MW1011 : WORD := (383);
AT %MW1012 : WORD := (383);
AT %MW1013 : WORD := (383);
AT %MW1014 : WORD := (383);
AT %MW1015 : WORD := (383);

Voilà à quoi doit resembler mon nouveau fichier
Num pts;U Alt; I Alt; % PID; U Exi;I Ext
384;380;10;50;10;50
384;381;10;51.1;10;51
384;382;10;52;10;45

Et voilà le bout de code que j'ai déjà testé et qui marche seulement pour extraire la dernier ligne :

Private Sub Command2_Click()

i= 0
Set fs = CreateObject("Scripting.FileSystemObject")
Set donnees = fs.OpenTextFile("D:\Affaires\CLAUDEL Vincent 02_2009\Essais D3 040309" + "\essai.txt", 1, False, 0)

If donnees.AtEndOfStream <> True Then
    C = 0
    'Do Until donnees.AtEndOfStream
  For i = 0 To 10
    
    ReadC = donnees.readline
    
'vérification des lignes avec données, et extraction de celle-ci
    If Left(ReadC, 2) = "AT" Then
     
    Mypo = InStr(1, ReadC, "(")
    Mypo2 = InStr(1, ReadC, ")")
    NbCar = Mypo2 - Mypo
    C = Mid(ReadC, Mypo + 1, NbCar - 1)
    i = i + 1
    t = i
    Text4.Text = t
   
    End If
        
            If C = True And 0 < i <= 999 Then
            Montableau(0, 999) = C & Chr(9)
            Text3.Text = Montableau(0, 999)
                   
            End If
           
     Next i
    'Loop
Else
    MsgBox "Fin du fichier", vbExclamation, "Avertissement"
End If

End Sub

Merci de votre aide

cs_Jack · Accepted Answer

Salut
En VB6, il y a plus pratique que le FSO (FileSystemObject)
Voir :
- Instructions Open, Line Input #, Close #, Do-Loop
- Instructions Split pour le découpage de chaque ligne
- Boule de cristal pour savoir comment tu passes de ton exemple à la ligne finale (d'où viennent les 380;10;50;10;50 ?)
- la recherche parmi les codes en excluant .Net, de simples mots comme "lecture fichier"

Vala
Jack, MVP VB
NB : Je ne répondrai pas aux messages privés

<hr />Le savoir est la seule matière qui s'accroit quand on la partage (Socrate)

viclaudel · Answer

oui merci pour les infos j'ai un peu modifier mon code, maintenant j'arrive à lire et traiter toutes les 1000 premières lignes. Mais par contre après j'utilise un tableau pour le mettre en colonne. Les données ce mette toutes sur la dernier ligne du tableau pour le premier traitement. Et je n'arrive pas traiter les 1000 suivant pour la 2èm" colonne. Pour la boule de cristal j'avais fais un exemple. Le fichier que je dois traiter correspond à 5000 lignes. Les 1000 premier valeur doivent faire la première colonne du nouveau fichier, les 1000 autres la 2ème colonne ainsi de suite. Je vais te montrer ce que j'obtiens avec mon nouveau code. Nouveau code : Private Sub Command1_Click() Dim FSys, fs, Mypo, Mypo2, NbCar 'pour creation du fichier Dim MonFich, ReadC 'indication du nom du fichier Dim Msg 'message de réussite Dim Name 'nom du nouveau fichier Dim donnees Dim i, j As Integer Dim C, C2 As String Dim t As Variant Dim Montableau(0 To 2, 0 To 999) As String Dim chaine 'on récupére les données inscritent par l'utilisateur G_CheminFichier = TXT_Chemin_Fichier.Text G_NomFichier = TXT_Nom_Fichier.Text G_NomFichierText = TXT_Nom_Fichier_Texte.Text 'Lecture If G_NomFichier <> "" Then 'ouverture du fichier source Open G_CheminFichier + G_NomFichier For Input As #1 For i = 0 To 1999 Line Input #1, ReadC 'If Trim(ReadC) <> "" Then 'If Trim(ReadC) <> "" Then 'extraction de la valeur If Left(ReadC, 2) = "AT" Then Mypo = InStr(1, ReadC, "(") Mypo2 = InStr(1, ReadC, ")") NbCar = Mypo2 - Mypo C = Mid(ReadC, Mypo + 1, NbCar - 1) i = i + 1 'mise de la valeur dans un tableau en fonction du numéro de la ligne If 0 < i <= 999 Then Montableau(0, 999) = Montableau(0, 999) & vbCrLf & C & ";" Else Montableau(1, 999) = Montableau(1, 999) & vbCrLf & C & ";" End If End If 'mise de valeur dans un chaine chaine = CStr(Montableau(0, 999)) & CStr(Montableau(1, 999)) Next i Close #1 End If Text1.Text = chaine 'ecriture dans le nouveau fichier Set FSys = CreateObject("Scripting.FileSystemObject") Set MonFich = FSys.createtextfile("D:\Name.txt") With MonFich .writeline ("Num pts;U Alt; I Alt; % PID; U Exi;I Ext") .writeline chaine End With Et le résultat dans le nouveau fichier : Num pts;U Alt; I Alt; % PID; U Exi;I Ext 384; 384; 384; 384; 384; 384; 384; 383; 383; 383; 383; 383; 383; 383; 383; 383; 383; 383; 383; je ne mets pas les 1000 lignes Quand je regarde en pas à pas et en analysant mon tableau je vois que toutes les valeurs sont sur la dernier ligne du tableau pour les 1000 premier par contre rien pour la suite. Je crois que j'ai encore un problème pour bien extraire la valeur et la mettre dans le nouveau fichier, ligne par ligne.

cs_Jack · Answer

Re
Un fichier texte n'est pas un tableaur.
Il n'y a pas d'instruction qui permette d'écrire à la suite d'une ligne.
Un fichier s'écrit de gauche à doite et de bas en haut.
Comme tu as beaucoup de données, je ne te conseille pas de mémoriser toutes les valeurs dans un tableau pour les écrire ensuite proprement dans le fichier; tu risquerais de saturer la mémoire.
Par contre, tu peux :
- Fermer ton fichier une fois que tu as écrit la première colonne
- Réouvrir le fichier en lecture seule (A)
- Ouvrir un second fichier (B) pour écrire le contenu de chaque ligne de (A) --> (B) en y ajoutant les données de la colonne suivante
- Boucler cette manip pour chaque colonne que tu as besoin d'ajouter aux lignes

D'autre part :
- à quoi sert Tableau(0, 999) et Tableau(1, 999) ?
Puisque tu ne t'en sert que pour stocker une simple chaine, pourquoi passer par un si gros tableau ?
- For i = ...
   i = i + 1
   Next i
Ca, ça va merder à un moment.
Si une variable sert à un For-Next, ne pas modifier la valeur de i
Si tu dois sauter une chiffre sur deux (c'est ce que tu fais), complète le For avec un Step 2
Mais comme tu ne te sert pas de 'i', à quoi sert le For-Next ?
Dans n'importe quelle source qui parle de lire un fichier texte, tu aurais découvert cette syntaxe de boucle :
   Do While Not EOF(1)
      Line Input ...
      ...
   Loop

Ah oui, j'ai compris ce que tu veux faire avec ton tableau.
En fait, tu veux stocker chaque ligne dans une variable (voir plus haut)
Donc, cela veut dire :
- qu'il faut mettre 'i' dans la dimension du tableau à la place de 999, ça n'a pas de sens, exemple :
      Montableau(0, i)= Montableau(0, i) & vbCrLf & C & ";"
- qu'il faut supprimer ce vbCrLf qui ne sert à rien, sauf à passer à la ligne, donc, à placer après C;
- qu'il ne faut pas écrire dans le fichier tant que tu n'es pas sûr d'avoir lu la deuxième valeur, donc, DANS la branche du IF après le ELSE, là où tu viens de récolter la 2ème et dernière valeur

Beaucoup de choses à revoir ...

Vala
Jack, MVP VB
NB : Je ne répondrai pas aux messages privés

<hr />Le savoir est la seule matière qui s'accroit quand on la partage (Socrate)

viclaudel · Answer

Merci pour tous les infos, je vais encore modifier mes programmes surtout pour la mémoire. Car là j'ai fait 2 programme différent. J'arrive à faire mes colonnes et à traiter tous les valeurs. Voilà mes 2 programmes encore en travaux. Private Sub transfert_Click() Dim ColA() Dim ColB() Dim ColC() Dim ColD() Dim ColE() Dim ColF() Dim Nb As Long Nb = 1 Dim Temp As String Dim Nombre As String 'Recupération des données renseigner par l'opérateur G_CheminFichier = TXT_Chemin_Fichier.Text G_NomFichier = TXT_Nom_Fichier.Text G_NomFichierText = TXT_Nom_Fichier_Texte.Text 'lecture, stockage, recup dans tableau Open G_CheminFichier & G_NomFichier For Input As #1 Do While Not EOF(1) Line Input #1, Temp 'si la ligne commence par AT extraction des chiffre en () If Mid(Temp, 1, 2) = "AT" Then 'If Left(Temp, 2) = "AT" Then Dim PosDep As Integer Dim PosFin As Integer Dim t As Integer PosDep = InStr(1, Temp, "(", vbTextCompare) PosFin = InStr(PosDep, Temp, ")", vbTextCompare) Nombre = Mid(Temp, PosDep + 1, PosFin - PosDep - 1) If Nb = 1999 Then Dim toto As Integer toto = 1 End If t = Nb Text1.Text = t Select Case Nb Case 1 To 1000 ReDim Preserve ColA(Nb - 1) ColA(Nb - 1) = Nombre Case 1001 To 2000 ReDim Preserve ColB(Nb - 1 - 1000) ColB(Nb - 1 - 1000) = Nombre Case 2001 To 3000 ReDim Preserve ColC(Nb - 1 - 2000) ColC(Nb - 1 - 2000) = Nombre Case 3001 To 4000 ReDim Preserve ColD(Nb - 1 - 3000) ColD(Nb - 1 - 3000) = Nombre Case 4001 To 5000 ReDim Preserve ColE(Nb - 1 - 4000) ColE(Nb - 1 - 4000) = Nombre Case 5001 To 6000 ReDim Preserve ColF(Nb - 1 - 5000) ColF(Nb - 1 - 5000) = Nombre End Select Nb = Nb + 1 End If Loop Close #1 'Test de la valeur Dim valeurLimite As Long valeurLimite = UBound(ColA) If (valeurLimite <> UBound(ColB)) Or (valeurLimite <> UBound(ColC)) Or _ (valeurLimite <> UBound(ColD)) Or (valeurLimite <> UBound(ColE)) Then 'Gestion erreur MSg = "Valeur pas valide" MsgBox (MSg) End End If 'écriture du fichier dans nouveau fichier Open ("D:\essai2.text") For Output As #1 Print #1, ("Num pts;U Alt; I Alt; % PID; U Exi;I Ext") For i = 0 To UBound(ColA) On Error Resume Next 'au cas ou il y a pas 5000 entré d extraite du fichier Print #1, ColA(i) & ";" & ColB(i) & ";" & ColC(i) & ";" & ColD(i) & ";" & ColE(i) & ";" Next i Close #1 MSg = "fin" MsgBox (MSg) ********************************************************************************** Dim Msg 'message de réussite Dim i, Mypo, Mypo2, NbCar As Integer Dim C, ReadC As String Dim t, y As String Dim Montableau(0 To 5, 0 To 999) As String Dim chaine As Variant Dim TailleFichierTexte, EcrasementFichier, ExistanceFichier As String 'renvoie la taille du fichier Texte Dim TXT As String 'envoie l'extantion du fichier texte d'origine 'on récupére les données inscritent par l'utilisateur G_CheminFichier = TXT_Chemin_Fichier.Text G_NomFichier = TXT_Nom_Fichier.Text G_NomFichierText = TXT_Nom_Fichier_Texte.Text 'vérification de lafin du fichier du chemin qui doit finir pa "" 'TailleFichierTexte = Trim(G_CheminFichier) 'TailleFichierTexte = Len(G_CheminFichier) 'Dans le cas ou rien n'est écrit on va au message erreur 'If TailleFichierTexte = "0" Then GoTo fin1 'TXT = Mid(G_CheminFichier, TailleFichierTexte) 'Si l 'extantion n'est pas correcte alors on arrete et on affiche un message d'erreur 'If TXT <> "" Then GoTo fin2 ' Verification que le fichier texte d'origine à une extantion .TXT ou .txt 'TailleFichierTexte = Trim(G_NomFichier) ' TailleFichierTexte = Len(G_NomFichier) ' If TailleFichierTexte = "0" Then GoTo fin3 ' TXT = Mid(G_NomFichier, TailleFichierTexte - 3) 'Si l'extantion n'est pas correcte alors on arrete et on affiche un message d'erreur 'If TXT <> ".txt" And TXT <> ".TXT" Then GoTo fin4 'Si l'extantion n'est pas correcte alors on arrete et on affiche un message d'erreur 'If TXT <> ".txt" And TXT <> ".TXT" And TXT <> ".dat" And TXT <> ".DAT" And TXT <> ".doc" And TXT <> ".DOC" Then GoTo fin2 ' Verification que le fichier destination n'existe pas encore pour eviter d'ecraser des données 'EcrasementFichier = Dir(G_CheminFichier & G_NomFichier) 'If EcrasementFichier = G_NomFichierText Then GoTo fin6 'ExistanceFichier = Dir(G_CheminFichier & G_NomFichier) 'If ExistanceFichier = "" Then GoTo fin5 ' Verication que le fichier texte de destination à une extantion .TXT ou .txt ou .DAT ou .dat ou .DOC ou .doc 'TailleFichierTexte = Trim(G_NomFichierText) 'TailleFichierTexte = Len(G_NomFichierText) 'If TailleFichierTexte = "0" Then GoTo fin3 'TXT = Mid(G_NomFichierText, TailleFichierTexte - 3) 'Lecture If G_NomFichier <> "" Then 'ouverture du fichier source Open G_CheminFichier + G_NomFichier For Input As #1 'boucle sur 5000 lignes i = 0 Do While i < 5000 'gestion d'erreur si moins de 5000 lignes On Error Resume Next Line Input #1, ReadC If Err.Number <> 0 Then Err.Clear Exit Do End If 'extraction de la valeur If Left(ReadC, 2) = "AT" Then Mypo = InStr(1, ReadC, "(") Mypo2 = InStr(1, ReadC, ")") NbCar = Mypo2 - Mypo C = Mid(ReadC, Mypo + 1, NbCar - 1) 'mise de la valeur dans un tableau en fonction du numéro de la ligne If i <= 999 Then Montableau(0, i) = C ElseIf i <= 1999 Then Montableau(1, i - 1000) = C ElseIf i <= 2999 Then Montableau(2, i - 2000) = C ElseIf i <= 3999 Then Montableau(3, i - 3000) = C ElseIf i <= 4999 Then Montableau(4, i - 4000) = C End If 'comptage du nombre valeurs extraite et affichage i = i + 1 t = i Text3.Text = t End If Loop For i = 0 To 999 'conétation des valeurs du tableau dans une chaine chaine = chaine & CStr(Montableau(0, i)) & ";" & CStr(Montableau(1, i)) & ";" & CStr(Montableau(2, i)) & ";" & CStr(Montableau(3, i)) & ";" & CStr(Montableau(4, i)) & vbCrLf Next i Close #1 Text1.Text = chaine 'ecriture dans le nouveau fichier Open ("D:\Name.text") For Output As #1 Print #1, ("Num pts;U Alt; I Alt; % PID; U Exi;I Ext") Print #1, chaine Close #1 End If Msg = ("FIN") MsgBox (Msg) fin1: MsgBox "Veuillez entrer le chemin du fichier d'origine" Command1.Enabled = True Exit Sub fin2: MsgBox "Le chemin doit finir par le caractère \ , Exemple: C:\Program Files\ " Command1.Enabled = True Exit Sub fin3: MsgBox "Veuillez entrer le nom du fichier d'origine" Command1.Enabled = True Exit Sub fin4: MsgBox " Le nom du fichier saisi dans le champ 'Nom du fichier source .TXT' est faux, veuillez saisir par exemple 'essai.txt'" Command1.Enabled = True Exit Sub fin5: MsgBox "AucunFichier" Command1.Enabled = True Exit Sub fin6: MsgBox "EcrasementFichier" Command1.Enabled = True Exit Sub

Traitement fichier Text en VB6

4 réponses

Votre réponse

Discussions similaires