TextStream en mode Appending

Version imprimable

Bonjour au Forum,

je cherche à inverser l'ordre des enregistrements dans mon fichier logg.txt. Ceci dans le but d'avoir en première ligne les derniers utilisateurs enregistrés.

En mode ajout il ne le fait pas (il fait l'inverse). Comment contourner le pb, SVP ? (la méthode des tableaux existent mais peut-on faire autrement ?)

mon bout de code
Code:

1 2 3 4 5 6 7 8 9 10 Dim oTXT As Scripting.TextStream Dim oFSO As Scripting.FileSystemObject Set oFSO = New Scripting.FileSystemObject Set oTXT = oFSO.OpenTextFile(ThisWorkbook.Path & "\" & "logg.txt", ForAppending) With oTXT .WriteLine Environ("USERNAME") & " " & Now .Close End With
Merci d'avance pour votre aide.

12/12/2016, 09h10
Invité

Bonjour

Il faut stocker tes données dans un tableau et tout réecrire en partant bouclant à partir de la fin de ton tableau et d'un pas de -1 dans une boucle.

Tu ne peux actuellement qu'écrire à la fin.

Philippe
12/12/2016, 09h15
Marc-L

Bonjour !

Citation:

Envoyé par esse2016

En mode ajout il ne le fait pas

C'est normal ! Le mode "Ajout" ajoute donc une ligne à la fin du fichier comme décrit dans la documentation …

Tu peux lire le fichier dans une variable tableau puis réécrire entièrement le fichier texte en commençant
par l'insertion de la nouvelle ligne puis par le contenu de la variable tableau …
12/12/2016, 09h36
esse2016

bonjour merci à vous deux,

je vais m'orienter vers un tableau.
Par contre je dois compter le nombre de ligne de mon fichier txt pour dimensionner mon tableau.

Mais actuellement ma routine boucle à l'infini et le While Not .AtEndOfStream ne semble pas marcher. une idée ?

=> oublier ce message, j'avais oublié le .SkipLine (honte à moi)
12/12/2016, 09h55
Marc-L

En fait ce n'est qu'une question de pure logique ‼

Si tu tiens à utiliser FSO (pouvant être source de ralentissement et inutile en pur VBA ayant déjà tout le nécessaire !),
lire l'intégralité du fichier via ReadAll (aucune utilité de lire les lignes une par une !)
puis le recréer en commençant par la nouvelle ligne puis par l'ancien fichier en mémoire …

Bonjour,
Il faut voir la structure de ton fichier!

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
Enum ConstAdo
adSmallInt = 2
     adInteger = 3
     adSingle = 4
     adDate = 7
     adBoolean = 11
     adDecimal = 14
     adNumeric = 131
     adVarChar = 200
End Enum
Enum ConsAdoCon
    adOpenKeyset = 1
    adLockPessimistic = 2
    adUseClient = 3
    adFldMayBeNull = 64
End Enum
Sub test()
 
Set oFSO = CreateObject("Scripting.FileSystemObject")
 
 
 
Set oTXT = oFSO.OpenTextFile("C:\Users\dysorthographie\Desktop\Az.txt")
 ReadAllTextFile = oTXT.ReadAll
oTXT.Close
ReadAllTextFile = Split(ReadAllTextFile, vbCrLf)
 
 
 
 
Set rstADO = CreateObject("ADODB.Recordset")
With rstADO
   ' .Fields.Append "EmployeeID", adInteger, , adFldKeyColumn
    .Fields.Append "A", adVarChar, 10, adFldMayBeNull
    .Fields.Append "B", adVarChar, 10, adFldMayBeNull
    '.Fields.Append "LastName", adVarChar, 20, adFldMayBeNull
    '.Fields.Append "Email", adVarChar, 64, adFldMayBeNull
    '.Fields.Append "Include", adInteger, , adFldMayBeNull
    '.Fields.Append "Selected", adBoolean, , adFldMayBeNull
 
 
    .CursorType = adOpenKeyset
    .CursorLocation = adUseClient
    .LockType = adLockPessimistic
    .Open
End With
For i = 0 To UBound(ReadAllTextFile)
    rstADO.AddNew
    rstADO("a") = Split(ReadAllTextFile(i), ";")(0)
    rstADO("b") = Split(ReadAllTextFile(i), ";")(1)
     rstADO.Update
Next
 rstADO.AddNew
    rstADO("a") = Environ("Username")
 rstADO.Update
  rstADO.Sort = "a DESC"
 ReadAllTextFile = rstADO.GetString
End Sub

12/12/2016, 10h16
Marc-L

Salut Robert !

Il n'est pas nécessaire de découper le fichier en lignes individuelles !

Lecture du fichier dans une variable, création du nouveau fichier, écriture de la nouvelle ligne puis écriture de la variable …
12/12/2016, 10h19
Invité

bonjour marc,
je pensai qu'il voulait trié son fichier!

alors désolé je suis très basique et j'ai à chaque fois une logique de débutant car je lis ligne par ligne voici mon code avec tableau (mais des soucis avec le writing mode car je ne sais pas effacer le contenu d'un fichier, j'utilise write "" mais je me génére des lignes vierges intercalées)
oui y a un tri car le appending me mets tout à l'envers (ce qui est normal). Et en plus pour pas ralentir je voudrais me limiter à 100 enregistrements.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
Private Sub WriteFichierTXT()
Dim oFSO As Scripting.FileSystemObject
Dim oTXT As Scripting.TextStream
Dim Tab1(99), Tab2() As String
Dim NbLigne As Integer
 
 
'Instancion du fichier FSO
Set oFSO = New Scripting.FileSystemObject
Set oTXT = oFSO.OpenTextFile(ThisWorkbook.Path & "\" & "logg.txt", ForAppending)
With oTXT
.WriteLine Environ("USERNAME") & " " & Now
.Close
End With
 
Set oFSO = Nothing
Set oTXT = Nothing
 
'mettre en ordre croissant les enregistrements des utlisateurs
NbLigne = 0
Set oFSO = New Scripting.FileSystemObject
Set oTXT = oFSO.OpenTextFile(ThisWorkbook.Path & "\" & "logg.txt", ForReading)
With oTXT
While Not .AtEndOfStream
Tab1(99 - NbLigne) = .ReadLine
NbLigne = NbLigne + 1
Wend
.Close
End With
 
Set oFSO = Nothing
Set oTXT = Nothing
 
ReDim Tab2(0 To NbLigne - 1)
 
For i = 0 To 99
If Tab1(99 - i) <> "" Then Tab2(i) = Tab1(99 - i)
Next i
 
'efface le contenu du fichier
Set oFSO = New Scripting.FileSystemObject
Set oTXT = oFSO.OpenTextFile(ThisWorkbook.Path & "\" & "logg.txt", ForWriting, True)
With oTXT
.WriteLine ""
.Close
End With
 
Set oFSO = Nothing
Set oTXT = Nothing
 
 
 
'réecriture du fihcier dans l'ordre croissant
Set oFSO = New Scripting.FileSystemObject
Set oTXT = oFSO.OpenTextFile(ThisWorkbook.Path & "\" & "logg.txt", ForAppending, True)
With oTXT
For i = UBound(Tab2) To 0 Step -1
.WriteLine Tab2(i)
Next i
.Close
End With
 
Set oFSO = Nothing
Set oTXT = Nothing

12/12/2016, 10h51
Marc-L

Soyons logique : oublier déjà le mode Append ne correspondant pas au besoin ‼

Une fois le fichier dans le bon sens, la pure logique nécessite juste de lire l'intégralité du fichier dans une variable String
puis de recréer ce fichier en commençant par la nouvelle ligne puis par la variable contenant la globalité de l'ancien fichier …

P'tite démonstration, résultat dans la fenêtre Exécution :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Sub Demo4Noob()
       Const FICHIER = "C:\Windows\Temp\DemoLog.txt"
        Open FICHIER For Output As #8
        Print #8, "Initial  "; Now;
        Close #8
    For L% = 1 To 9
        Open FICHIER For Input As #8
        S$ = Input(LOF(8), #8)
        Close #8
        Open FICHIER For Output As #8
        Print #8, "Ligne"; L
        Print #8, S;
        Close #8
    Next
        Debug.Print "Résultat "; Now; " :" & vbLf
        Open FICHIER For Input As #8
        Debug.Print Input(LOF(8), #8)
        Close #8
End Sub

La boucle effectuant l'insertion d'une ligne à chaque itération …

Pour de gros fichiers, j'utilise plutôt ADODB.Stream.

12/12/2016, 12h35
esse2016

Merci Marc-L mais comme le dis le tuto de ce site

Rappel : En mode Output, le contenu du fichier est écrasé. Si vous souhaitez ajouter votre texte en fin de fichier, utilisez le mode Append.

donc je ne peux pas accumuler mais enregistrement avec le "outpout" de ta démo.
12/12/2016, 12h39
Marc-L

Donc tu n'as même pas regardé le résultat de ma démonstration correspondant pourtant à ton besoin,
du moins tel qu'il a été exposé ! Ne s'agissant pas d'ajouter mais d'insérer …

Citation:

Envoyé par esse2016

Merci Marc-L mais comme le dis le tuto de ce site

Rappel : En mode Output, le contenu du fichier est écrasé. Si vous souhaitez ajouter votre texte en fin de fichier, utilisez le mode Append.

donc je ne peux pas accumuler mais enregistrement avec le "outpout" de ta démo.

et laors!
Code:

1 2 3 4 5 6 7 8 9 10 Set oTXT = oFSO.OpenTextFile("C:\Users\dysorthographie\Desktop\Az.txt") ReadAllTextFile = oTXT.ReadAll oTXT.Close ReadAllTextFile = Environ("USERNAME") & " " & Now & vbcrlf & ReadAllTextFile Const FICHIER = "C:\Windows\Temp\DemoLog.txt" Open FICHIER For Output As #8 Print #8, ReadAllTextFile Close #8

12/12/2016, 12h52
esse2016

dysortho et marc-L votre programme marche

merci

Mais, :)

comment le limiter à 100 enregistrements (ou lignes comme vous préférez). Comment il va savoir qu' au 100eme enregistrement, le tout dernier doit être supprimé? (la date et heure du dernier élément est plus ancien que le prédédent)
12/12/2016, 12h56
Marc-L

Là il n'y a plus de rapport avant la demande initiale avec un Append non approprié car non compris !

Et comment deviner sans une présentation initiale digne de ce nom ?‼ C'est à dire claire & exhaustive …
T'en a d'autres des modifications de ce genre ?!

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Sub a()
Set oTXT = CreateObject("Scripting.FileSystemObject").OpenTextFile("C:\Users\dysorthographie\Desktop\Az.txt")
 ReadAllTextFile = oTXT.ReadAll
oTXT.Close
ReadAllTextFile = Environ("USERNAME") & " " & Now & vbCrLf & ReadAllTextFile
ReadAllTextFile = Split(ReadAllTextFile, vbCrLf)
For i = 0 To UBound(ReadAllTextFile)
    txt = txt & ReadAllTextFile(i) & vbCrLf
    If i = 99 Then Exit For
Next
Const FICHIER = "C:\Users\dysorthographie\Desktop\Az.txt"
        Open FICHIER For Output As #8
        Print #8, txt
        Close #8
End Sub

Robert,

quitte à utiliser Split autant utiliser Join :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Sub Demo4Noob()
      Const FICHIER = "C:\Windows\Temp\DemoLog.txt"
        Dim L%, N&, SP$()
    For L = 1 To 110
        If Dir(FICHIER) > "" Then
            Open FICHIER For Input As #8
            SP = Split(Input(LOF(8), #8), vbNewLine)
            Close #8
            ReDim Preserve SP(Application.Min(UBound(SP) + 1, 99))
            For N = UBound(SP) To 1 Step -1:  SP(N) = SP(N - 1):  Next
        Else
            ReDim SP(0)
        End If
            SP(0) = "Ligne " & Format$(L, "000 : ") & Now
            Open FICHIER For Output As #8
            Print #8, Join$(SP, vbNewLine);
            Close #8
    Next
End Sub

_________________________________________________________________________________________________________

Merci de cliquer sur :plusser: pour chaque message ayant aidé puis sur :resolu: pour clore cette discussion …

12/12/2016, 13h20
Invité

bien vue Marc!
12/12/2016, 13h28
Marc-L

Je viens de modifier la ligne de code n°9, rien de bien extraordinaire !
(Et la 14 au cas où le demandeur ait un doute …)
12/12/2016, 13h31
Invité

Citation:

Envoyé par Marc-L

Je viens de modifier la ligne de code n°9, rien de bien extraordinaire !
(Et la 14 au cas où le demandeur ait un doute …)

Code:

SP = Split(Environ("USERNAME") & " " & Now & vbCrLf & Input(LOF(8), #8), vbNewLine)

Code:

For N = UBound(SP)To1Step-1: SP(N) = SP(N - 1): Next
12/12/2016, 13h40
Marc-L

Désolé Robert mais là je ne capte rien, ne décode pas, n'imprime pas, au choix !

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Sub Demo4Noob()     
 Const FICHIER ="C:\Users\dysorthographie\Desktop\Az.txt")
        Dim L%, N&, SP$()
    For L = 1 To 110
        If Dir(FICHIER) > "" Then
            Open FICHIER For Input As #8
            SP = Split(Environ("USERNAME") & " " & Now & vbCrLf & Input(LOF(8), #8), vbNewLine)
            Close #8
            ReDim Preserve SP(Application.Min(UBound(SP) + 1, 99))
           ' For N = UBound(SP) To 1 Step -1:  SP(N) = SP(N - 1):  Next
        Else
            ReDim SP(0)
        End If
            'SP(0) = "Ligne " & Format$(L, "000 : ") & Now
            Open FICHIER For Output As #8
            Print #8, Join$(SP, vbNewLine);
            Close #8
    Next
End Sub

Oui ! :plusser: Cela simplifie d'autant …

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub Demo4Noob()
  Const FICHIER = "C:\Windows\Temp\DemoLog.txt"
    Dim L%, S$, SP$()
    For L = 1 To 110
        S = "Ligne " & Format(L, "000 : ") & Now
        If Dir(FICHIER) > "" Then Open FICHIER For Input As #8: S = S & vbNewLine & Input(LOF(8), #8): Close #8
        SP = Split(S, vbNewLine)
        If UBound(SP) > 99 Then ReDim Preserve SP(99): S = Join(SP, vbNewLine)
        Open FICHIER For Output As #8
        Print #8, S;
        Close #8
    Next
End Sub

Edit : ~~modification en utilisant une variable Variant pour avoir en mémoire une seule fois les données …~~
Inutile vu le peu de lignes, retour du code en mode classique …

13/12/2016, 09h00
esse2016

Merci à vous deux cela répond à mon besoin.