Options de l'instruction FileSearch

Bonjour Frédéric,

Si tu permets, j'aurais une petite question sur la procédure test.

Voici la première ligne de code de la procédure test :
TousLesFichiers "D:fsdatas6OfficeVBA", 0, "58-02", Arr

Question I
Arr est une variable tableau...À quel moment est-elle renseignée ? Et, que contient-elle ?

Question II

Le "0" de la ligne d'appel, ne pourrait-on pas définir cette variable dans la procédure locale de
"TousLesFichiers....)... je saisi pas vraiment son rôle dans la ligne d'appel de la procédure.


Merci à l'avance Frédéric pour ta collaboration.


Bonne journée,


Salutations!


"Frédéric Sigonneau" <frederic.sigonneau@wanadoo.fr> a écrit dans le message de news:3F6C8250.B532496D@wanadoo.fr...
Bonjour,

FileSearch est un objet qui offre certaines facilités de mise en oeuvre, mais
qui, AMA, est assez (voire très) lent. Je te propose une autre approche avec le
FileSystemObject et ses possibilités de recherche d'une chaine de caractères en
lisant un fichier comme un 'flux de texte' (je ne sais s'il y a une traduction
officielle pour TextStream). Je pense que cette méthode devrait donner les
résultats attendus, mais il faudrait faire des essais.

Le code (après ma signature) est à recopier dans un module standard du classeur
qui t'intéresse. La procédure qui fait le travail (TousLesFichiers) renvoie les
resultats trouvés dans un tableau. Elle est lancée par la procédure test, qui
affiche ensuite les résultats trouvés dans un nouveau classeur (à adapter si tu
veux une destination précise).

FS
--
Frédéric Sigonneau [MVP Excel - né un sans-culottide]
Gestions de temps, VBA pour Excel :
http://perso.wanadoo.fr/frederic.sigonneau
Si votre question sur Excel est urgente, évitez ma bal !

'=============================== Sub test()
Dim Arr(), i&
TousLesFichiers "D:fsdatas6OfficeVBA", 0, "58-02", Arr
Workbooks.Add
With ActiveWorkbook.ActiveSheet
For i = LBound(Arr) To UBound(Arr)
.Range("A" & i + 1).Value = Arr(i)
.Hyperlinks.Add Anchor:=.Range("A" & i + 1), Address:=Arr(i)
Next i
.Range("A1").EntireColumn.AutoFit
End With
End Sub

Sub TousLesFichiers(LeDossier$, tabCount As Long, ChaineCherchée$, _
tabloFichiers() As Variant, Optional SousDossiers = True)
Dim FSO As Object, Dossier As Object
Dim sousRep As Object, Fich As Object
Dim TextStream
' Constante pour l'ouverture des fichiers
Const OpenFileForReading = 1

Set FSO = CreateObject("Scripting.FileSystemObject")
Set Dossier = FSO.GetFolder(LeDossier)

'examen du dossier courant
For Each Fich In Dossier.Files
Set TextStream = Fich.OpenAsTextStream(OpenFileForReading)
Do While Not TextStream.AtEndOfStream
S = TextStream.ReadLine
If InStr(1, S, ChaineCherchée, vbTextCompare) > 0 Then
ReDim Preserve tabloFichiers(tabCount)
tabloFichiers(tabCount) = Fich.path
tabCount = tabCount + 1
Exit Do
End If
Loop
TextStream.Close
Next

If Not SousDossiers Then Exit Sub 'sans les sous dossiers, on arrête

'traitement récursif des sous dossiers
For Each sousRep In Dossier.SubFolders
TousLesFichiers sousRep.path, tabCount, ChaineCherchée, tabloFichiers
Next sousRep

End Sub 'fs
'===============================

Bonjour à tous,

Suite à une question posée précédement (cf Rechercher chaine de caratères
dans word), je rencontre quelques soucis dans l'utilisation éfficace de
l'instruction FileSearch.
Voir mon code de départ plus bas:
Les chaines recherchées sont situées sur la feuille n°1
Les résultats des recherches sont renvoyés sur la feuille n°2

Le problème est que si les cellules A1 --> A5 de la feuille n°1 contiennent
respectivement les valeurs 58-01 ; 58-02 ; 58-03 ; 58-04 ; 58-05 les
résultats renvoyés sont tous similaires et ne tiennent compte que de la
partie précédent le tiret de séparation, à savoir le 58.

Y'a-t-il une possibilité de forcer la procédure à prendre en compte
exclusivement la totalité de la chaine recherchée ? (.MatchTextExactly > True 'ne semble fonctionner comme je m'y attendais...)

Par avance merçi,

Kristof

'---------------------------------------------
Sub test()
Dim I, J, Pointeur As Long
Dim ChaineCherchée, Chemin As String

Chemin = ChoisirDossier ' ou pour le test "C:Documents and
SettingsccampainMes documents" ' dossier à scanner
If Chemin = "" Then Exit Sub
Pointeur = 1
For J = 1 To Sheets(1).Range("A1").End(xlDown).Row ' La feuille n°1 contient
toutes les valeurs à rechercher
ChaineCherchée = Sheets(1).Cells(J, 1).Value
With Application.FileSearch
.NewSearch
.FileType = msoFileTypeAllFiles
.FileName = "*.*"
.LookIn = Chemin
.MatchTextExactly = True ' Ne semble pas fonctionner comme je m'y
attendais....
.TextOrProperty = ChaineCherchée 'cherche le texte test dans les
documents
.SearchSubFolders = True
.Execute

If .FoundFiles.Count > 0 Then
Sheets(2).Cells(Pointeur, 1) = ChaineCherchée ' La feuille n° 2
contient les résultats renvoyés
With .FoundFiles
ReDim Classeurs(1 To .Count, 1 To 1)

For I = 1 To .Count
Sheets(2).Cells(Pointeur + I - 1, 2) = Dir$(.Item(I))
Sheets(2).Cells(Pointeur + I - 1, 3) = .Item(I)
Sheets(2).Hyperlinks.Add Anchor:Îlls(Pointeur + I - 1,
2), Address:Îlls(Pointeur + I - 1, 3).Value, TextToDisplay:Îlls(Pointeur
+ I - 1, 2).Value ' Conversion lien hypertexte
Next I
Pointeur = Pointeur + .Count + 1
End With
End If
End With
Next J
End Sub

Private Function ChoisirDossier()
Dim objShell, objFolder, Chemin, SecuriteSlash

Set objShell = CreateObject("Shell.Application")
Set objFolder = _
objShell.BrowseForFolder(&H0&, "Choisisser un répertoire", &H1&)
On Error Resume Next
Chemin = objFolder.ParentFolder.ParseName(objFolder.Title).Path & ""
If objFolder.Title = "Bureau" Then
Chemin = "C:WindowsBureau"
End If
If objFolder.Title = "" Then
Chemin = ""
End If

SecuriteSlash = InStr(objFolder.Title, ":")

If SecuriteSlash > 0 Then
Chemin = Mid(objFolder.Title, SecuriteSlash - 1, 2) & ""
End If
ChoisirDossier = Chemin
End Function

---------------------------------------------

Bonjour Denis,

Voici la première ligne de code de la procédure test :
TousLesFichiers "D:fsdatas6OfficeVBA", 0, "58-02", Arr

Question I
Arr est une variable tableau...À quel moment est-elle renseignée ? Et, que contient-elle ?

Le tableau Arr est renseigné par la procédure TousLesFichiers (c'est le
paramètre tabloFochiers de cette procédure). En fin d'exécution, Arr contient
les fichiers où ChaineCherchée a été trouvée. Il faudrait ajouter quelques
lignes de code pour gérer la cas de figure où la recherche n'a pas abouti.

Question II

Le "0" de la ligne d'appel, ne pourrait-on pas définir cette variable dans la procédure locale de
"TousLesFichiers....)... je saisi pas vraiment son rôle dans la ligne d'appel de la procédure.

TousLesFichiers cherche à remplir un tableau (tabloFichiers) avec les chemins
complets des fichiers trouvés correspondant à un critère (une chaine de
caractères donnée). Au départ, on ne connait pas le nombre de fichiers qui vont
être trouvés et le tableau est donc vide. A chaque fois qu'on trouve un fichier
une variable est incrémentée (il s'agit de tabCount) et le tableau est
redimensionné à l'aide de cette variable.
Pour pouvoir examiner les sous-dossiers éventuels, cette procédure est récursive
(elle s'appelle elle-même). Et c'est pour cela qu'il faut définir tabCount *à
l'extérieur* de la procédure, de manière à ce qu'elle puisse conserver sa valeur
(et donc réellement préserver le contenu du tableau à chaque redimensionnement).
Si tabCount était une variable locale de TousLesFichiers, elle serait
réinitialisée à chaque appel de la procédure (cad à chaque examen d'un nouveau
dossier) et seuls les fichiers trouvés dans le dernier dossier qui contenait des
fichiers correspondant au critère seraient renvoyés comme résultat.
(Il y aurait sans doute une autre manière de procéder en déclarant tabCount
comme variable locale Static, mais je trouve ce type de déclaration plus délicat
à contrôler que la déclaration d'une variable externe).

Merci à l'avance Frédéric pour ta collaboration.

De rien. A+

FS
--
Frédéric Sigonneau [MVP Excel - né un sans-culottide]
Gestions de temps, VBA pour Excel :
http://perso.wanadoo.fr/frederic.sigonneau
Si votre question sur Excel est urgente, évitez ma bal !

Bonne journée,

Salutations!

"Frédéric Sigonneau" <frederic.sigonneau@wanadoo.fr> a écrit dans le message de news:3F6C8250.B532496D@wanadoo.fr...
Bonjour,

FileSearch est un objet qui offre certaines facilités de mise en oeuvre, mais
qui, AMA, est assez (voire très) lent. Je te propose une autre approche avec le
FileSystemObject et ses possibilités de recherche d'une chaine de caractères en
lisant un fichier comme un 'flux de texte' (je ne sais s'il y a une traduction
officielle pour TextStream). Je pense que cette méthode devrait donner les
résultats attendus, mais il faudrait faire des essais.

Le code (après ma signature) est à recopier dans un module standard du classeur
qui t'intéresse. La procédure qui fait le travail (TousLesFichiers) renvoie les
resultats trouvés dans un tableau. Elle est lancée par la procédure test, qui
affiche ensuite les résultats trouvés dans un nouveau classeur (à adapter si tu
veux une destination précise).

FS
--
Frédéric Sigonneau [MVP Excel - né un sans-culottide]
Gestions de temps, VBA pour Excel :
http://perso.wanadoo.fr/frederic.sigonneau
Si votre question sur Excel est urgente, évitez ma bal !

'=============================== > Sub test()
Dim Arr(), i&
TousLesFichiers "D:fsdatas6OfficeVBA", 0, "58-02", Arr
Workbooks.Add
With ActiveWorkbook.ActiveSheet
For i = LBound(Arr) To UBound(Arr)
.Range("A" & i + 1).Value = Arr(i)
.Hyperlinks.Add Anchor:=.Range("A" & i + 1), Address:=Arr(i)
Next i
.Range("A1").EntireColumn.AutoFit
End With
End Sub

Sub TousLesFichiers(LeDossier$, tabCount As Long, ChaineCherchée$, _
tabloFichiers() As Variant, Optional SousDossiers = True)
Dim FSO As Object, Dossier As Object
Dim sousRep As Object, Fich As Object
Dim TextStream
' Constante pour l'ouverture des fichiers
Const OpenFileForReading = 1

Set FSO = CreateObject("Scripting.FileSystemObject")
Set Dossier = FSO.GetFolder(LeDossier)

'examen du dossier courant
For Each Fich In Dossier.Files
Set TextStream = Fich.OpenAsTextStream(OpenFileForReading)
Do While Not TextStream.AtEndOfStream
S = TextStream.ReadLine
If InStr(1, S, ChaineCherchée, vbTextCompare) > 0 Then
ReDim Preserve tabloFichiers(tabCount)
tabloFichiers(tabCount) = Fich.path
tabCount = tabCount + 1
Exit Do
End If
Loop
TextStream.Close
Next

If Not SousDossiers Then Exit Sub 'sans les sous dossiers, on arrête

'traitement récursif des sous dossiers
For Each sousRep In Dossier.SubFolders
TousLesFichiers sousRep.path, tabCount, ChaineCherchée, tabloFichiers
Next sousRep

End Sub 'fs
'=============================== >

Bonjour à tous,

Suite à une question posée précédement (cf Rechercher chaine de caratères
dans word), je rencontre quelques soucis dans l'utilisation éfficace de
l'instruction FileSearch.
Voir mon code de départ plus bas:
Les chaines recherchées sont situées sur la feuille n°1
Les résultats des recherches sont renvoyés sur la feuille n°2

Le problème est que si les cellules A1 --> A5 de la feuille n°1 contiennent
respectivement les valeurs 58-01 ; 58-02 ; 58-03 ; 58-04 ; 58-05 les
résultats renvoyés sont tous similaires et ne tiennent compte que de la
partie précédent le tiret de séparation, à savoir le 58.

Y'a-t-il une possibilité de forcer la procédure à prendre en compte
exclusivement la totalité de la chaine recherchée ? (.MatchTextExactly > > True 'ne semble fonctionner comme je m'y attendais...)

Par avance merçi,

Kristof

'---------------------------------------------
Sub test()
Dim I, J, Pointeur As Long
Dim ChaineCherchée, Chemin As String

Chemin = ChoisirDossier ' ou pour le test "C:Documents and
SettingsccampainMes documents" ' dossier à scanner
If Chemin = "" Then Exit Sub
Pointeur = 1
For J = 1 To Sheets(1).Range("A1").End(xlDown).Row ' La feuille n°1 contient
toutes les valeurs à rechercher
ChaineCherchée = Sheets(1).Cells(J, 1).Value
With Application.FileSearch
.NewSearch
.FileType = msoFileTypeAllFiles
.FileName = "*.*"
.LookIn = Chemin
.MatchTextExactly = True ' Ne semble pas fonctionner comme je m'y
attendais....
.TextOrProperty = ChaineCherchée 'cherche le texte test dans les
documents
.SearchSubFolders = True
.Execute

If .FoundFiles.Count > 0 Then
Sheets(2).Cells(Pointeur, 1) = ChaineCherchée ' La feuille n° 2
contient les résultats renvoyés
With .FoundFiles
ReDim Classeurs(1 To .Count, 1 To 1)

For I = 1 To .Count
Sheets(2).Cells(Pointeur + I - 1, 2) = Dir$(.Item(I))
Sheets(2).Cells(Pointeur + I - 1, 3) = .Item(I)
Sheets(2).Hyperlinks.Add Anchor:Îlls(Pointeur + I - 1,
2), Address:Îlls(Pointeur + I - 1, 3).Value, TextToDisplay:Îlls(Pointeur
+ I - 1, 2).Value ' Conversion lien hypertexte
Next I
Pointeur = Pointeur + .Count + 1
End With
End If
End With
Next J
End Sub

Private Function ChoisirDossier()
Dim objShell, objFolder, Chemin, SecuriteSlash

Set objShell = CreateObject("Shell.Application")
Set objFolder = _
objShell.BrowseForFolder(&H0&, "Choisisser un répertoire", &H1&)
On Error Resume Next
Chemin = objFolder.ParentFolder.ParseName(objFolder.Title).Path & ""
If objFolder.Title = "Bureau" Then
Chemin = "C:WindowsBureau"
End If
If objFolder.Title = "" Then
Chemin = ""
End If

SecuriteSlash = InStr(objFolder.Title, ":")

If SecuriteSlash > 0 Then
Chemin = Mid(objFolder.Title, SecuriteSlash - 1, 2) & ""
End If
ChoisirDossier = Chemin
End Function

---------------------------------------------

Re Denis,

Je n'avais pas vérifié avec des fichiers Word. Je pensais que la méthode
OpenAsTextFile était générique et pouvait lire n'importe quel type de fichiers
comme du texte. Je constate comme toi que ce n'est pourtant pas le cas pour des
fichiers Word. Il y a certainement quelque chose qui m'échappe, mais je n'ai pas
trouvé quoi.
Par ailleurs je n'avais pas fait suffisamment attention au fait que le demandeur
voulait faire une recherche dans des fichiers Word (uniquement, semble-t-il,
sinon, un mélange des deux solutions est envisageable).
Du coup, je te propose (ainsi qu'à Christophe) un contournement en utilisant la
fonction de recherche de Word soi-même. Chez moi ça donne les résultats
attendus, mais c'est à tester. Et mon objectif premier d'accélérer l'exécution
par rapport à FileSearch ne me parait pas vraiment atteint, mais là aussi c'est
à tester.

FS
--
Frédéric Sigonneau [MVP Excel - né un sans-culottide]
Gestions de temps, VBA pour Excel :
http://perso.wanadoo.fr/frederic.sigonneau
Si votre question sur Excel est urgente, évitez ma bal !

'============================= Sub test()
Dim Arr(), i&, RacineRecherche$, DimTablo&, S$

RacineRecherche = "D:fsdatas6OfficeVBA0ExemplesEtTests"
DimTablo = 0
TousLesFichiersDocs RacineRecherche, DimTablo, "58-02", Arr
On Error Resume Next
S = Dir(Arr(0))
If Err <> 0 Then
MsgBox "aucun fichier trouvé"
Exit Sub
End If
On Error GoTo 0
Workbooks.Add
With ActiveWorkbook.ActiveSheet
For i = LBound(Arr) To UBound(Arr)
.Range("A" & i + 1).Value = Arr(i)
.Hyperlinks.Add Anchor:=.Range("A" & i + 1), Address:=Arr(i)
Next i
.Range("A1").EntireColumn.AutoFit
End With

End Sub


Sub TousLesFichiersDocs(LeDossier$, tabCount As Long, ChaineCherchée$, _
tabloFichiers() As Variant, Optional SousDossiers = True)
Dim FSO As Object, Dossier As Object
Dim sousRep As Object, Fich As Object
Dim Wrd As Object, Doc As Object, Trouvé As Boolean

Set FSO = CreateObject("Scripting.FileSystemObject")
Set Dossier = FSO.GetFolder(LeDossier)

'examen du dossier courant
For Each Fich In Dossier.Files
If Right(UCase(Fich.path), 3) = "DOC" Then
On Error Resume Next
Set Wrd = GetObject(, "Word.Application")
On Error GoTo 0
If Wrd Is Nothing Then Set Wrd = CreateObject("Word.Application")
Set Doc = Wrd.documents.Open(Fich.path)
Trouvé = Doc.content.Find.Execute(ChaineCherchée)
Doc.Close (0): Set Doc = Nothing
If Trouvé Then
ReDim Preserve tabloFichiers(tabCount)
tabloFichiers(tabCount) = Fich.path
tabCount = tabCount + 1
End If
End If
Next

If Not SousDossiers Then GoTo Fin 'Exit Sub 'sans les sous dossiers, on
arrête

'traitement récursif des sous dossiers
For Each sousRep In Dossier.SubFolders
TousLesFichiersDocs sousRep.path, tabCount, ChaineCherchée, tabloFichiers
Next sousRep

Fin:
If Not Wrd Is Nothing Then
Wrd.Quit (0)
Set Wrd = Nothing
End If
End Sub 'fs
'=============================

Bonjour Frédéric,

Merci pour tous ces commentaires.

Voilà l'expérience tentée :

J'ai créé un répertoire excel dans lequel j'ai placé 3 documents "Word" avec très peu de texte dont la chaîne "58-02"

Le résultat : Aucun des fichiers n'a été trouvé. Évidemment la procédure se plante parce que la variable "Arr" qui
devrait contenir la liste trouvée est vide. En y regardant de plus près, Cette ligne de commande n'affiche jamais la
ligne de texte inscrite dans le fichier.

S = TextStream.ReadLine

La variable S est toujours égale à une série de "Carré" ....

Je crois que le problème est là ...La procédure n'arrive pas à lire chaque ligne du fichier ... au moins dans mon petit
test que j'ai fait sur des fichiers "Word" ... puisque c'était sur ce type de fichiers que le demandeur voulait faire
ces recherches.

Si j'ajoute un fichier ".txt", la procédure exécute normalement et correctement. Est-ce là une limitation normale de la
procédure c'est-à-dire applicable seulement sur des fichiers ".txt".

Merci pour tes commentaires.

Salutations!

"Frédéric Sigonneau" <frederic.sigonneau@wanadoo.fr> a écrit dans le message de news:3F6D95D6.9AF44E9F@wanadoo.fr...
Bonjour Denis,

Voici la première ligne de code de la procédure test :
TousLesFichiers "D:fsdatas6OfficeVBA", 0, "58-02", Arr

Question I
Arr est une variable tableau...À quel moment est-elle renseignée ? Et, que contient-elle ?

Le tableau Arr est renseigné par la procédure TousLesFichiers (c'est le
paramètre tabloFochiers de cette procédure). En fin d'exécution, Arr contient
les fichiers où ChaineCherchée a été trouvée. Il faudrait ajouter quelques
lignes de code pour gérer la cas de figure où la recherche n'a pas abouti.

Question II

Le "0" de la ligne d'appel, ne pourrait-on pas définir cette variable dans la procédure locale de
"TousLesFichiers....)... je saisi pas vraiment son rôle dans la ligne d'appel de la procédure.

TousLesFichiers cherche à remplir un tableau (tabloFichiers) avec les chemins
complets des fichiers trouvés correspondant à un critère (une chaine de
caractères donnée). Au départ, on ne connait pas le nombre de fichiers qui vont
être trouvés et le tableau est donc vide. A chaque fois qu'on trouve un fichier
une variable est incrémentée (il s'agit de tabCount) et le tableau est
redimensionné à l'aide de cette variable.
Pour pouvoir examiner les sous-dossiers éventuels, cette procédure est récursive
(elle s'appelle elle-même). Et c'est pour cela qu'il faut définir tabCount *à
l'extérieur* de la procédure, de manière à ce qu'elle puisse conserver sa valeur
(et donc réellement préserver le contenu du tableau à chaque redimensionnement).
Si tabCount était une variable locale de TousLesFichiers, elle serait
réinitialisée à chaque appel de la procédure (cad à chaque examen d'un nouveau
dossier) et seuls les fichiers trouvés dans le dernier dossier qui contenait des
fichiers correspondant au critère seraient renvoyés comme résultat.
(Il y aurait sans doute une autre manière de procéder en déclarant tabCount
comme variable locale Static, mais je trouve ce type de déclaration plus délicat
à contrôler que la déclaration d'une variable externe).

Merci à l'avance Frédéric pour ta collaboration.

De rien. A+

FS
--
Frédéric Sigonneau [MVP Excel - né un sans-culottide]
Gestions de temps, VBA pour Excel :
http://perso.wanadoo.fr/frederic.sigonneau
Si votre question sur Excel est urgente, évitez ma bal !

Bonne journée,

Salutations!

"Frédéric Sigonneau" <frederic.sigonneau@wanadoo.fr> a écrit dans le message de news:3F6C8250.B532496D@wanadoo.fr...
Bonjour,

FileSearch est un objet qui offre certaines facilités de mise en oeuvre, mais
qui, AMA, est assez (voire très) lent. Je te propose une autre approche avec le
FileSystemObject et ses possibilités de recherche d'une chaine de caractères en
lisant un fichier comme un 'flux de texte' (je ne sais s'il y a une traduction
officielle pour TextStream). Je pense que cette méthode devrait donner les
résultats attendus, mais il faudrait faire des essais.

Le code (après ma signature) est à recopier dans un module standard du classeur
qui t'intéresse. La procédure qui fait le travail (TousLesFichiers) renvoie les
resultats trouvés dans un tableau. Elle est lancée par la procédure test, qui
affiche ensuite les résultats trouvés dans un nouveau classeur (à adapter si tu
veux une destination précise).

FS
--
Frédéric Sigonneau [MVP Excel - né un sans-culottide]
Gestions de temps, VBA pour Excel :
http://perso.wanadoo.fr/frederic.sigonneau
Si votre question sur Excel est urgente, évitez ma bal !

'=============================== > > Sub test()
Dim Arr(), i&
TousLesFichiers "D:fsdatas6OfficeVBA", 0, "58-02", Arr
Workbooks.Add
With ActiveWorkbook.ActiveSheet
For i = LBound(Arr) To UBound(Arr)
.Range("A" & i + 1).Value = Arr(i)
.Hyperlinks.Add Anchor:=.Range("A" & i + 1), Address:=Arr(i)
Next i
.Range("A1").EntireColumn.AutoFit
End With
End Sub

Sub TousLesFichiers(LeDossier$, tabCount As Long, ChaineCherchée$, _
tabloFichiers() As Variant, Optional SousDossiers = True)
Dim FSO As Object, Dossier As Object
Dim sousRep As Object, Fich As Object
Dim TextStream
' Constante pour l'ouverture des fichiers
Const OpenFileForReading = 1

Set FSO = CreateObject("Scripting.FileSystemObject")
Set Dossier = FSO.GetFolder(LeDossier)

'examen du dossier courant
For Each Fich In Dossier.Files
Set TextStream = Fich.OpenAsTextStream(OpenFileForReading)
Do While Not TextStream.AtEndOfStream
S = TextStream.ReadLine
If InStr(1, S, ChaineCherchée, vbTextCompare) > 0 Then
ReDim Preserve tabloFichiers(tabCount)
tabloFichiers(tabCount) = Fich.path
tabCount = tabCount + 1
Exit Do
End If
Loop
TextStream.Close
Next

If Not SousDossiers Then Exit Sub 'sans les sous dossiers, on arrête

'traitement récursif des sous dossiers
For Each sousRep In Dossier.SubFolders
TousLesFichiers sousRep.path, tabCount, ChaineCherchée, tabloFichiers
Next sousRep

End Sub 'fs
'=============================== > >

Bonjour à tous,

Suite à une question posée précédement (cf Rechercher chaine de caratères
dans word), je rencontre quelques soucis dans l'utilisation éfficace de
l'instruction FileSearch.
Voir mon code de départ plus bas:
Les chaines recherchées sont situées sur la feuille n°1
Les résultats des recherches sont renvoyés sur la feuille n°2

Le problème est que si les cellules A1 --> A5 de la feuille n°1 contiennent
respectivement les valeurs 58-01 ; 58-02 ; 58-03 ; 58-04 ; 58-05 les
résultats renvoyés sont tous similaires et ne tiennent compte que de la
partie précédent le tiret de séparation, à savoir le 58.

Y'a-t-il une possibilité de forcer la procédure à prendre en compte
exclusivement la totalité de la chaine recherchée ? (.MatchTextExactly > > > True 'ne semble fonctionner comme je m'y attendais...)

Par avance merçi,

Kristof

'---------------------------------------------
Sub test()
Dim I, J, Pointeur As Long
Dim ChaineCherchée, Chemin As String

Chemin = ChoisirDossier ' ou pour le test "C:Documents and
SettingsccampainMes documents" ' dossier à scanner
If Chemin = "" Then Exit Sub
Pointeur = 1
For J = 1 To Sheets(1).Range("A1").End(xlDown).Row ' La feuille n°1 contient
toutes les valeurs à rechercher
ChaineCherchée = Sheets(1).Cells(J, 1).Value
With Application.FileSearch
.NewSearch
.FileType = msoFileTypeAllFiles
.FileName = "*.*"
.LookIn = Chemin
.MatchTextExactly = True ' Ne semble pas fonctionner comme je m'y
attendais....
.TextOrProperty = ChaineCherchée 'cherche le texte test dans les
documents
.SearchSubFolders = True
.Execute

If .FoundFiles.Count > 0 Then
Sheets(2).Cells(Pointeur, 1) = ChaineCherchée ' La feuille n° 2
contient les résultats renvoyés
With .FoundFiles
ReDim Classeurs(1 To .Count, 1 To 1)

For I = 1 To .Count
Sheets(2).Cells(Pointeur + I - 1, 2) = Dir$(.Item(I))
Sheets(2).Cells(Pointeur + I - 1, 3) = .Item(I)
Sheets(2).Hyperlinks.Add Anchor:Îlls(Pointeur + I - 1,
2), Address:Îlls(Pointeur + I - 1, 3).Value, TextToDisplay:Îlls(Pointeur
+ I - 1, 2).Value ' Conversion lien hypertexte
Next I
Pointeur = Pointeur + .Count + 1
End With
End If
End With
Next J
End Sub

Private Function ChoisirDossier()
Dim objShell, objFolder, Chemin, SecuriteSlash

Set objShell = CreateObject("Shell.Application")
Set objFolder = _
objShell.BrowseForFolder(&H0&, "Choisisser un répertoire", &H1&)
On Error Resume Next
Chemin = objFolder.ParentFolder.ParseName(objFolder.Title).Path & ""
If objFolder.Title = "Bureau" Then
Chemin = "C:WindowsBureau"
End If
If objFolder.Title = "" Then
Chemin = ""
End If

SecuriteSlash = InStr(objFolder.Title, ":")

If SecuriteSlash > 0 Then
Chemin = Mid(objFolder.Title, SecuriteSlash - 1, 2) & ""
End If
ChoisirDossier = Chemin
End Function

---------------------------------------------