Suppresion d'une ligne de donné dans un fichier .TXT selon un ID

Version imprimable

06/11/2018, 11h06
Superzest 76

Suppresion d'une ligne de donné dans un fichier .TXT selon un ID
Bonjour a tous ,
Alors j'ai une application qui permet au utilisateur de se logger grâce a un capteur biométrique le capteur biometrique ecrit une ligne dans un fichier txt
voila un exemple de fichier txt
Code:

1 2 3 4 5 6 8;Vallet;Esteban 1;Her;Bruno 2;leGros;Henri7 3;Petitgros;Michel 5;Vito;Abdoulaye
le but est de choisir la ligne ou l'id= 2 et de la supprimer

Merci d'avance :D pour votre aide

Salut

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
dim ContenuFichier 'pour simuler ton fichier
ContenuFichier =        "8;Vallet;Esteban" & vbnewline & _
                        "1;Her;Bruno" & vbnewline & _
                        "2;leGros;Henri7" & vbnewline & _
                        "3;Petitgros;Michel" & vbnewline & _
                        "5;Vito;Abdoulaye"
 
dim TblLignes
TblLignes = split(ContenuFichier,vbnewline)
dim TblColonnes
dim NewContenuFichier
dim MotRechercher
dim T
 
IdRechercher = "2"
For T = 0 to ubound(TblLignes)
        TblColonnes = split(TblLignes(t),";")
        if TblColonnes(0)<> IdRechercher Then
                NewContenuFichier = NewContenuFichier & TblLignes(t)
                If T <> ubound(TblLignes) Then NewContenuFichier = NewContenuFichier & vbnewline
        End If
Next
 
'pour debeug
MsgBox NewContenuFichier

Tu ouvres ton fichier et tu mets le contenu dans la variable ContenuFichier, tu fermes ton fichier.
Une fois passé par le code fournis, tu écrases ton fichier en écrivant le contenu de la variable NewContenuFichier .

Re

Une petite gestion plus judicieuse du retour à la ligne ajouté à la variable NewContenuFichier
Code:

1 2 3 4 if TblColonnes(0)<> IdRechercher Then If NewContenuFichier <> "" Then NewContenuFichier = NewContenuFichier & vbnewline NewContenuFichier = NewContenuFichier & TblLignes(t) End If
En effet, si l'Id a éliminé est le dernier du tableau TblLignes, la condition If T <> ubound(TblLignes) Then NewContenuFichier = NewContenuFichier & vbnewline ajoutait un saut de ligne si l'Id a supprimé est la dernière ligne du fichier.

06/11/2018, 13h42
Superzest 76

Merci beaucoup pour ton aide ^^
;) c'est super de mettre ses compétence au service des autres ^^
:merci: :merci: :merci:

salut,

un autre exemple qui utilise la fonction Filter souvent méconnue

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Dim ContenuFichier 'pour simuler ton fichier
ContenuFichier =        "8;Vallet;Esteban" & vbnewline & _
                        "1;Her;Bruno" & vbnewline & _
                        "2;leGros;Henri7" & vbnewline & _
                        "3;Petitgros;Michel" & vbnewline & _
                        "5;Vito;Abdoulaye"
 
Dim TblLignes,IDRec,NewContenuFichier
TblLignes = Split(ContenuFichier,vbNewLine)
IDRec = "2;"
NewContenuFichier = Join(Filter(TblLignes,IDRec,False),vbNewLine)
 
'pour debeug
MsgBox NewContenuFichier

2 avantages et un possible inconvénient comparé au code proposé par ProgElecT
- plus compact et surtout plus rapide et robuste si le fichier texte comporte des centaines de lignes voire des milliers
- inutilisable si le nom de l'utiilisateur (pas le prénom) se termine par le même nombre que l'ID recherchée ex : "3;Petitgros2;Michel"

edit : l'inconvénient n'existait que dans mon imagination :oops: le code (modifié) ultra-compact :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
Dim ContenuFichier 'pour simuler ton fichier
ContenuFichier =        "8;Vallet;Esteban" & vbnewline & _
                        "1;Her;Bruno" & vbnewline & _
                        "2;leGros;Henri7" & vbnewline & _
                        "3;Petitgros2;Michel" & vbnewline & _
                        "5;Vito;Abdoulaye"
 
Dim IDRec,NewContenuFichier
IDRec = vbLf & "2;"
NewContenuFichier = Join(Filter(Split(ContenuFichier,vbCr),IDRec,False),vbCr)
'pour debeug
MsgBox NewContenuFichier

07/11/2018, 08h43
Superzest 76

re

@omen999 Super merci beaucoup pour ton aide
:merci:

Code final

Salut voila donc le code final avec ('Quelque commentaire')

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
'----------------------------------------------------------------------------------------'
'
'											Script de delogg 															
'
'----------------------------------------------------------------------------------------'
'declaration de variable
Dim ContenuFichier ,fichier , Badge , Newfichier
Dim TblColonnes
Dim BADGEdelogg
Dim MotRechercher
Dim T , fso
 
'Preparation de l'environement 
Set fso = CreateObject("Scripting.FileSystemObject")
'Le chemin d'accès du fichier peut etre ecrit ici  
Badge = "C:\Users\PRODERGIE\Documents\Badge.txt"
'Ouverture du fichier Badge.txt
Set fichier = fso.opentextfile("Badge", 1)
'Permet de lire le contenue du fichier badge.txt
ContenuFichier = fichier.ReadAll
'Ferme le dossier 
fichier.Close
Set fichier = Nothing
'Declatation de Tblligne tableau qui permet de stocker les lignes 
Dim TblLignes
' Permet séparer chaque ligne du fichier badge.txt et de les sauvegarder dans un tableau
TblLignes = Split(ContenuFichier,vbNewLine)
 
'Recherche de l'id 8 (admin) pour pouvoir supprimier la ligne du fichier badge.txt
MotRechercher = "8;"
'Selection et supresion de la ligne contenant l'ID voulue 
BadgeDelogg = Join(Filter(TblLignes,MotRechercher,False),vbNewLine)
'/!\ Pour debog et afficher la valeur de Badge delog activer la commande si dessous /!\
'Msgbox(BadgeDelogg)
'*** Préparation de l'environnement	
Const ForWriting = 2 '***Permet d'ecrire les données
Set fso = CreateObject("Scripting.FileSystemObject")
'Definition du chemin d'acces 
'*** Création du fichier texte
Set NewFichier = fso.OpenTextFile(Badge,ForWriting,True)
'*** Ecriture des données de la variable "data" dans le fichier texte.
NewFichier.Write(BADGEdelogg)
NewFichier.close
'*** Ouverture de la page d'acueil
$Open("1 Page Aceuil.SCC")

J’espère que ça pourra aider quelqu’un ;)

07/11/2018, 11h50
ProgElecT

Salut
:plusser:
Merci d'avoir pris le temps de résumer et poster ton code très bien commenté, cela devrait rendre service à bien des forumeurs qui passeront par là.

[Edit solution]

Re désoler de up le thread :pastaper: mais je voulais apporter une petit correction car en effet si le fichier Badge.txt est vide le script renvois une erreur 50 voila la solution que j'ai trouver pour empêcher ça

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
 
Dim stFichier 'Nom du Fichier a tester  
Dim oFSO,oFl 
Set oFSO = CreateObject("Scripting.FileSystemObject") 
	stFichier = "D:\Vitogaz\Log\Log.txt"
'Test l'existance du fichier   
	If oFSO.FileExists(stFichier) Then 
	Set oFl = oFSO.GetFile(stFichier) 
End If
	If oFl.Size > 0 Then  'Si plus de 1 octet dans le fichier Txt alors 
        '------------------------------------
        '
        '          SCRIPT ici
        '
        '---------------------------------------
End if