Logo GNT
Actualités Tests & Guides Bons Plans
GTA 6 iPhone 17 Copilot Switch 2 Temu ChatGPT Tesla
OVH Cloud OVH Cloud
Entraide Applications Microsoft Office Excel Rechercher CHAINE de caractères dans fichier WORD

Rechercher CHAINE de caractères dans fichier WORD

4 réponses
Avatar
Christophe CAMPAIN
Bonjour à tous !

Je cherche à récupérer dans une feuille de calcul le nom de chaque fichier
"WORD" contenant une chaine de caractère spécifique.
(L'équivalent de la fonction rechercher de windows, mais de manière
automatique)

Par avance merçi pour votre aide.

Kristof
Signaler un problème avec ce contenu

4 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Avatar
michdenis
Bonjour Christophe,

Cette macro va chercher dans tous sous répertoires du répertoire désigné les fichiers comportant l'expression défini.

'--------------------------------
Sub ChercherExpression()
Dim Expression As String, A As Integer
Dim Repertoire As String

'****Variables à déterminer**********

Repertoire = "C:Mes documents"
Expression = "Autobus"

'****Variables à déterminer**********

With Application.FileSearch
.NewSearch
.LookIn = Repertoire
.SearchSubFolders = True
.FileType = msoFileTypeWordDocuments 'Word
.TextOrProperty = Expression
If .Execute() > 0 Then
MsgBox .FoundFiles.Count & " fichier(s) trouvé(s)."
For A = 1 To .FoundFiles.Count
MsgBox .FoundFiles(i)
'ou les copier dans un classeur
'With Worksheets("Feuil1")
'.Range("A" & A) = .FoundFiles(i)
'End If
Next
Else
MsgBox "Aucun fichier avec ce mot."
End If
End With
End Sub
'--------------------------------


Salutations!

"Christophe CAMPAIN" a écrit dans le message de
news:
Bonjour à tous !

Je cherche à récupérer dans une feuille de calcul le nom de chaque fichier
"WORD" contenant une chaine de caractère spécifique.
(L'équivalent de la fonction rechercher de windows, mais de manière
automatique)

Par avance merçi pour votre aide.

Kristof
Avatar
michdenis
Il y a une légère correction a été fait


'--------------------------------
Sub ChercherExpression()
Dim Expression As String, A As Integer
Dim Repertoire As String

'****Variables à déterminer**********

Repertoire = "C:Mes documents"
Expression = "Autobus"

'****Variables à déterminer**********

With Application.FileSearch
.NewSearch
.LookIn = Repertoire
.SearchSubFolders = True
.FileType = msoFileTypeWordDocuments 'Word
.TextOrProperty = Expression
If .Execute() > 0 Then
MsgBox .FoundFiles.Count & " fichier(s) trouvé(s)."
For A = 1 To .FoundFiles.Count
MsgBox .FoundFiles(A)
'ou les copier dans un classeur
'With Worksheets("Feuil1")
'.Range("A" & A) = .FoundFiles(A)
'End If
Next
Else
MsgBox "Aucun fichier avec ce mot."
End If
End With
End Sub
'--------------------------------


Salutations!



"michdenis" a écrit dans le message de news:
Bonjour Christophe,

Cette macro va chercher dans tous sous répertoires du répertoire désigné les fichiers comportant l'expression défini.

'--------------------------------
Sub ChercherExpression()
Dim Expression As String, A As Integer
Dim Repertoire As String

'****Variables à déterminer**********

Repertoire = "C:Mes documents"
Expression = "Autobus"

'****Variables à déterminer**********

With Application.FileSearch
.NewSearch
.LookIn = Repertoire
.SearchSubFolders = True
.FileType = msoFileTypeWordDocuments 'Word
.TextOrProperty = Expression
If .Execute() > 0 Then
MsgBox .FoundFiles.Count & " fichier(s) trouvé(s)."
For A = 1 To .FoundFiles.Count
MsgBox .FoundFiles(i)
'ou les copier dans un classeur
'With Worksheets("Feuil1")
'.Range("A" & A) = .FoundFiles(i)
'End If
Next
Else
MsgBox "Aucun fichier avec ce mot."
End If
End With
End Sub
'--------------------------------


Salutations!

"Christophe CAMPAIN" a écrit dans le message de
news:
Bonjour à tous !

Je cherche à récupérer dans une feuille de calcul le nom de chaque fichier
"WORD" contenant une chaine de caractère spécifique.
(L'équivalent de la fonction rechercher de windows, mais de manière
automatique)

Par avance merçi pour votre aide.

Kristof
Avatar
Christophe CAMPAIN
Merçi beaucoup !

C'est exactement ce que je recherchais.
A un détail prés tout de même, les résultats renvoyés par cette recherche ne
sont pas suffisement précis; je m'explique :

Aprés quelques bidouilles, voici mon code
---------------------------------------------
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

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

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?

Par avance merçi,

Kristof


"michdenis" a écrit dans le message de news:

Bonjour Christophe,

Cette macro va chercher dans tous sous répertoires du répertoire désigné
les fichiers comportant l'expression défini.


'--------------------------------
Sub ChercherExpression()
Dim Expression As String, A As Integer
Dim Repertoire As String

'****Variables à déterminer**********

Repertoire = "C:Mes documents"
Expression = "Autobus"

'****Variables à déterminer**********

With Application.FileSearch
.NewSearch
.LookIn = Repertoire
.SearchSubFolders = True
.FileType = msoFileTypeWordDocuments 'Word
.TextOrProperty = Expression
If .Execute() > 0 Then
MsgBox .FoundFiles.Count & " fichier(s) trouvé(s)."
For A = 1 To .FoundFiles.Count
MsgBox .FoundFiles(i)
'ou les copier dans un classeur
'With Worksheets("Feuil1")
'.Range("A" & A) = .FoundFiles(i)
'End If
Next
Else
MsgBox "Aucun fichier avec ce mot."
End If
End With
End Sub
'--------------------------------


Salutations!

"Christophe CAMPAIN" a écrit
dans le message de

news:
Bonjour à tous !

Je cherche à récupérer dans une feuille de calcul le nom de chaque fichier
"WORD" contenant une chaine de caractère spécifique.
(L'équivalent de la fonction rechercher de windows, mais de manière
automatique)

Par avance merçi pour votre aide.

Kristof






Avatar
michdenis
Bonjour Chritophe,


Ton résultat est normal en ce sens que si tu fais ta recherche à partir de l'explorateur, tu obtiendras le même
résultat.

Je ne saurais dire pourquoi Windows ( ce n'est pas un problème d'excel) n'arrive pas à rechercher une chaîne 58-01 dans
un fichier sans se méprendre par exemple avec un fichier contenant 58-02 .

Si quelqu'un peut expliquer ce comportement bizarre :

Si un document contient 58-02 : il trouve
Si un document contient 58-01 : il inclut dans la liste trouvé les fichiers contenant 58-02
Si un document contient 58-000 : il inclut aussi les fichiers contenant 58-001

En fait, les résultats sont très aléatoires !!!


Quelqu'un a une explication ? Une façon de faire autrement ?



Salutations!


"Christophe CAMPAIN" a écrit dans le message de
news:
Merçi beaucoup !

C'est exactement ce que je recherchais.
A un détail prés tout de même, les résultats renvoyés par cette recherche ne
sont pas suffisement précis; je m'explique :

Aprés quelques bidouilles, voici mon code
---------------------------------------------
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

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

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?

Par avance merçi,

Kristof


"michdenis" a écrit dans le message de news:

Bonjour Christophe,

Cette macro va chercher dans tous sous répertoires du répertoire désigné
les fichiers comportant l'expression défini.


'--------------------------------
Sub ChercherExpression()
Dim Expression As String, A As Integer
Dim Repertoire As String

'****Variables à déterminer**********

Repertoire = "C:Mes documents"
Expression = "Autobus"

'****Variables à déterminer**********

With Application.FileSearch
.NewSearch
.LookIn = Repertoire
.SearchSubFolders = True
.FileType = msoFileTypeWordDocuments 'Word
.TextOrProperty = Expression
If .Execute() > 0 Then
MsgBox .FoundFiles.Count & " fichier(s) trouvé(s)."
For A = 1 To .FoundFiles.Count
MsgBox .FoundFiles(i)
'ou les copier dans un classeur
'With Worksheets("Feuil1")
'.Range("A" & A) = .FoundFiles(i)
'End If
Next
Else
MsgBox "Aucun fichier avec ce mot."
End If
End With
End Sub
'--------------------------------


Salutations!

"Christophe CAMPAIN" a écrit
dans le message de

news:
Bonjour à tous !

Je cherche à récupérer dans une feuille de calcul le nom de chaque fichier
"WORD" contenant une chaine de caractère spécifique.
(L'équivalent de la fonction rechercher de windows, mais de manière
automatique)

Par avance merçi pour votre aide.

Kristof