Trouver un mot dans un fichier .txt et remplacer le mot par un autre

**Gabriel1972** · 13/04/2023, 14h31

Bonjour,
je début en VB6 et je cherche un moyen de rechercher un mot dans un fichier .txt
Mes recherches m'ont mené à ce bout de code mais cela ne fonctionne pas.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Function TrouveEleve(ByVal ELEVEcible As String) As Boolean
Dim f As Long
Dim s As String
 
    TrouveEleve= False
 
    f = FreeFile
    Open App.Path & "\classe001.ini" For Input As #f
        Do While Not EOF(f)
            Input #f, s
 
 
            If Trim$(LCase$(s)) = Trim$(ELEVEcible ) Then
                TrouveEleve= True
                Close #f
                Exit Function
            ElseIf Trim$(LCase$(s)) = Trim$(ELEVEcible ) Then
                TrouveEleve= True
                Close #f
                Exit Function
            ElseIf Trim$(LCase$(s)) = Trim$(UCase$(ELEVEcible )) Then
                TrouveEleve= True
                Close #f
                Exit Function
            End If
        Loop
    Close #f
End Function

Le fichier Classe001.txt est le suivant

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
[PROFESSEUR PRINCIPAL]
nomduprofesseur = 0
 
[ELEVES]
Eleve001 = 1
Eleve002 = 2
Eleve003 = 3

Ce que je souhaite parvenir à faire c'est de lancer une recherche dans ce fichier et si Eleve002 est présent alors TrouveEleve= True
Je pense que le "=" et la valeur "2" doit le gener mais ces valeurs peuvent changer je ne peux donc les supprimer.

Merci pour votre aide

**ProgElecT** · 13/04/2023, 17h32

Salut

Je n'ai plus VB6 de disponible sur cette ordinateur, mais cela devrait ressembler à

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Function TrouveEleve(ByVal ELEVEcible As String) As Boolean
Dim f As Long
Dim s As String
Dim TblLgn
 
    TrouveEleve= False
 
    f = FreeFile
    Open App.Path & "\classe001.ini" For Input As #f
        Do While Not EOF(f)
            Input #f, s
			TblLgn = split(s,chr(32))
			TrouveEleve = Trim$(TblLgn(0))=Trim$(ELEVEcible)
			If TrouveEleve=True then exit Do
 
            'If Trim$(LCase$(s)) = Trim$(ELEVEcible ) Then
            '    TrouveEleve= True
            '    Close #f
            '    Exit Function
            'ElseIf Trim$(LCase$(s)) = Trim$(ELEVEcible ) Then
            '    TrouveEleve= True
            '    Close #f
            '    Exit Function
            'ElseIf Trim$(LCase$(s)) = Trim$(UCase$(ELEVEcible )) Then
            '    TrouveEleve= True
            '    Close #f
            '    Exit Function
            'End If
        Loop
    Close #f
End Function

**Gabriel1972** · 13/04/2023, 20h44

Merci PROGELECT d'avoir répondu mais cela ne fonctionne pas
TrouveEleve ressort en FALSE

**ProgElecT** · 13/04/2023, 22h06

Une autre approche en VBScript mais qui peut fonctionner directement en VB6

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Function TrouveEleve(NomFichier,ELEVEcible)
	Dim fso, fichier, ContenuFichier
 
	Set fso = CreateObject("Scripting.FileSystemObject")
	Set fichier = fso.opentextfile("C:\MesProgs\En VBScript et HTA\"&NomFichier, 1)
	ContenuFichier = fichier.ReadAll
	fichier.Close
	Set fichier = Nothing
 
        TrouveEleve = Cbool(InStr(1,ContenuFichier,trim(ELEVEcible),vbTextCompare))
 End Function
 
'exemples:
MsgBox TrouveEleve("Classe001.txt","Eleve002")  'existe dans le fichier
MsgBox TrouveEleve("Classe001.txt","Eleve002z") 'n'existe pas dans le fichier
MsgBox TrouveEleve("Classe003.txt","Eleve003")  'existe dans le fichier
MsgBox TrouveEleve("Classe003.txt","eLEVE003")  'existe dans le fichier mais pas les mêmes MAJ/min

Contenu de fichier Classe003.txt

[PROFESSEUR PRINCIPAL]
nomduprofesseur = 0

[ELEVES]
Eleve001 = 1
Eleve002 = 2
Eleve003 = 3
Eleve004 = 4

**Gabriel1972** · 14/04/2023, 08h02

YES !!! Bravo ProgElecT tout fonctionne !!

J'ai reussi à comprendre le code et l'adapter au projet.

Mille mercis!!
Belle continuation à vous

**Gabriel1972** · 14/04/2023, 16h00

Navré mais j'ai encore une question.
Dans le cas ELEVEcible est identifié comment remplacer "ELEVEcible" par un autre nom ex: "ELEVEcible2"

En résumé si ELEVEcible existe remplacer ELEVEcible par ELEVEcible2

Merci à vous

**ProgElecT** · 14/04/2023, 17h52

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Function TrouveEleve(NomFichier,ELEVEcible,MotRemplace)
	Dim fso, fichier, ContenuFichier, NewContenuFichier
 
	Set fso = CreateObject("Scripting.FileSystemObject")
	'ouverture en lecture
	Set fichier = fso.opentextfile("C:\MesProgs\En VBScript et HTA\"&NomFichier, 1)
	ContenuFichier = fichier.ReadAll
 
        TrouveEleve = Cbool(InStr(1,ContenuFichier,trim(ELEVEcible),vbTextCompare))
        If TrouveEleve Then
                fichier.Close
                Set fichier = Nothing
                NewContenuFichier = replace(ContenuFichier,trim(ELEVEcible),MotRemplace,1,-1,vbTextCompare)
                'ré-ouvre en écriture
                Set fichier = fso.opentextfile("C:\MesProgs\En VBScript et HTA\"&NomFichier, 2)
                fichier.Write NewContenuFichier
         End If
        fichier.close
        Set fichier = Nothing
        Set fso = Nothing
 End Function
 
'exemples:
MsgBox TrouveEleve("Classe001.txt","Eleve002","EleveNumero2")  & " remplacement fait"'existe dans le fichier Avec remplacement nom de l'eleve
MsgBox TrouveEleve("Classe001.txt","Eleve002z","AQUE coucou") & " pas de remplacement"'n'existe pas dans le fichier, donc pas de remplacement
MsgBox TrouveEleve("Classe003.txt","eLEVE003","NewEleve003")  & " remplacement fait"  'existe dans le fichier mais pas les mêmes MAJ/min, remplacement tout de même

**Gabriel1972** · 15/04/2023, 21h27

JE vous remercie infiniment pour votre sympathie et vos réponses

**umfred** · 18/04/2023, 14h03

Comme c'est un fichier ini, il existe des solutions prévues pour ce type de fichier (ça fait grosso modo la même chose mais en sous-main)
https://www.vbforums.com/showthread....te-an-Ini-file
je recopie ici les codes du lien:
code:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
'declarations for working with Ini files
Private Declare Function GetPrivateProfileSection Lib "kernel32" Alias _
    "GetPrivateProfileSectionA" (ByVal lpAppName As String, ByVal lpReturnedString As String, _
    ByVal nSize As Long, ByVal lpFileName As String) As Long
 
Private Declare Function GetPrivateProfileString Lib "kernel32" Alias _
    "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, _
    ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, _
    ByVal lpFileName As String) As Long
 
Private Declare Function WritePrivateProfileSection Lib "kernel32" Alias _
    "WritePrivateProfileSectionA" (ByVal lpAppName As String, ByVal lpString As String, _
    ByVal lpFileName As String) As Long
 
Private Declare Function WritePrivateProfileString Lib "kernel32" Alias _
    "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, _
    ByVal lpString As Any, ByVal lpFileName As String) As Long
 
'// INI CONTROLLING PROCEDURES
'reads an Ini string
Public Function ReadIni(Filename As String, Section As String, Key As String) As String
Dim RetVal As String * 255, v As Long
  v = GetPrivateProfileString(Section, Key, "", RetVal, 255, Filename)
  ReadIni = Left(RetVal, v - 1)
End Function
 
'reads an Ini section
Public Function ReadIniSection(Filename As String, Section As String) As String
Dim RetVal As String * 255, v As Long
  v = GetPrivateProfileSection(Section, RetVal, 255, Filename)
  ReadIniSection = Left(RetVal, v - 1)
End Function
 
'writes an Ini string
Public Sub WriteIni(Filename As String, Section As String, Key As String, Value As String)
  WritePrivateProfileString Section, Key, Value, Filename
End Sub
 
'writes an Ini section
Public Sub WriteIniSection(Filename As String, Section As String, Value As String)
  WritePrivateProfileSection Section, Value, Filename
End Sub

exemple utilisation:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Private Sub Form_Load()
 
Dim File As String, OFLen As Double,  Str As String
 
  File = "C:\temp.ini"
  OFLen = FileLen(File)
 
    'write a few example sections:
  WriteIniSection File, "Test1", ""
  WriteIniSection File, "Test2", "Here shoud be found some text"
 
    'write a few ini strings
  WriteIni File, "Test3", "Ini1", "This is ini 1"
  WriteIni File, "Test1", "Ini2", "This is ini 2"
 
    'test message - inform we've written the data
  MsgBox Format((FileLen(File) - OFLen) / 1024, "0.00") & " KB data written to " & Chr(34) & File & Chr(34)
 
    'read the ini file
  Str = Str & "Test2 section: " & vbTab & ReadIniSection(File, "Test2") & vbCrLf
  Str = Str & "Test1 section: " & vbTab & ReadIniSection(File, "Test1") & vbCrLf
  Str = Str & "Ini1 string: " & vbTab & ReadIni(File, "Test3", "Ini1") & vbCrLf
  Str = Str & "Ini2 string: " & vbTab & ReadIni(File, "Test1", "Ini2") & vbCrLf
 
    'show the data from the file
  MsgBox Str
 
End Sub

Trouver un mot dans un fichier .txt et remplacer le mot par un autre

VB 6 et antérieur

Discussions similaires

Partager

Partager