Une fonction recherchant l'occurrence d'une chaîne dans un fichier texte

Version imprimable

Salut;
C'est une première version de recherche de l'occurrence d'un mot(ou chaîne) dans un fichier texte :

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
Option Explicit
 'Version 1
Function Occurrence(sFile, strFind,bCasse)
   Const ForReading = 1
   Dim fso, FL, txt, Ret, nbr,S
   Set fso = CreateObject("Scripting.FileSystemObject")
   Set FL = fso.OpenTextFile(sFile, ForReading, False)
   nbr = 0
 
   Do While Not FL.AtEndOfStream 
          ' txt = ""  ' mise en commentaire après après la remarque de ProgElecT que je remercie beaucoup
	  txt=FL.ReadLine
	  Ret = InStr(1, Lcase(txt), Lcase(strFind),0)
	  If Ret <> 0 Then 
	     S = Mid(txt,Ret,Len(strFind))
		 'Condition pour la casse
	     If bCasse = True Then
	          If S = strFind Then nbr =nbr + 1
	     Else	
		  If Ucase(S) = Ucase(strFind) Then nbr =nbr + 1 
	     End If	
	  End If  
	Loop 
	FL.Close
	Occurrence = nbr
End Function

Utilisation :

Code:

1
2
3
Const Fich = "C:\Setuplog.txt"
MsgBox Occurrence(Fich,"line",True) ' Dans le texte il y a "Line"
MsgBox Occurrence(Fich,"line",False)

07/05/2012, 20h16
ProgElecT

:ccool:
La ligne 11 n'est pas indispensable
ligne 16 'Condition pour la casse ;) :mrgreen:
07/05/2012, 21h21
l_autodidacte

En effet, c'était un code de test que j'ai oublié de modifier(ligne 11) car j'avais autre chose en vue.
Ligne 16 : Ne dit-on pas respecter la Casse ? sinon je n'aurais pas bien saisi la remarque !
07/05/2012, 23h01
ProgElecT

Citation:

Ligne 16 : Ne dit-on pas respecter la Casse ? sinon je n'aurais pas bien saisi la remarque !

:pastaper: Cela fait à peu près 25 ans que je fais de l'informatique, cela fait donc 25 ans que je lis case :scarymov: :pleure:

Bonjour à tous;

La première version, si vous l'avez remarqué, ne recherche qu'une seule occurrence par ligne de texte.

Ci-dessous une deuxième version qui recherche toutes les occurrences d'une chaîne dans le fichier qu'il y en ait une ou plusieurs par ligne, la fonction les retrouve :

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
Option Explicit
   'Version 2
Function Occurrence(sFile, strFind,bCasse)
   Const ForReading = 1
   Dim fso, FL, txt, Ret, nbr, S, tbl
   Set fso = CreateObject("Scripting.FileSystemObject")
   Set FL = fso.OpenTextFile(sFile, ForReading, False)
   nbr = 0
	   Do 
		   txt = FL.ReadLine
		   Ret = InStr(1 , Lcase(txt), Lcase(strFind),0)
		   tbl = Split(Lcase(txt),Lcase(strFind))
		  If Ret > 0 Then 
			 S = Mid(txt,Ret,Len(strFind))
			 'Condition pour la CASSE
			 If bCasse = True Then
				If S = strFind  Then nbr = nbr + Ubound(tbl)
			 Else	
				If Ucase(S) = Ucase(strFind)  Then nbr = nbr + Ubound(tbl) 
			 End If	
		  End If  
		Loop Until FL.AtEndOfStream
	FL.Close
	Occurrence = nbr
End Function

Bonjour à tous;

Grâce aux suggestions et corrections de ProgElecT que je salue et remercie énormément, la version finale de la fonction Occurrence est :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
   'Version 3
Function Occurrence(sFile, strFind, bCasse)
Dim fso, FL, TxT
Set fso = CreateObject("Scripting.FileSystemObject")
 
If fso.FileExists(sFile) Then
   Set FL = fso.OpenTextFile(sFile, 1, False)
        TxT = FL.Readall
        FL.Close
        Set FL = Nothing: Set fso = Nothing
        If bCasse Then
             Occurrence = UBound(Split(TxT, strFind))
        Else
             Occurrence = UBound(Split(LCase(TxT), LCase(strFind)))
        End If
End If
End Function

Un code plus concis et moins gourmand en mémoire : C'est la version corrigée par les soins de notre cher ami ProgElecT