Rechercher mot dans entête et pied de page Word depuis Excel VBA
Bonjour,
je voudrai pouvoir rechercher la présence d'au moins un mot dans l'entête, le corps et le pied de page d'une liste de fichiers WORD stoché dans un même répertoire
J'ai adapté, un code qui me permet de rechercher dans le corps du word mais pas dans l'entête ni me pied de page.
En sortie, j'écris le nom du fichier, le mot recherché, un indicateur que me signale qu'il à trouvé le mot
Merci du coup de main.
le code actuel:
Dim wb As Workbook 'classeur Excel dans lequel on importe les données
Dim ws As Worksheet 'onglet Excel dans lequel on importe les données
Dim sChemin As String 'répertoire contenant les fichiers Word
Dim sNomFichier As String 'nom du fichier Word
Dim WApp As Object, WDoc As Object, WSel As Object, WSel2 As Object
Dim i As Integer
Dim j As Integer
Dim Max As Integer
Dim findMe As String
Dim Motcletrouve As Boolean
findMe = InputBox(Prompt:=" Find a specific word ")
Max = 2
' -- Variables initialisation
Set wb = ThisWorkbook
Set ws = wb.Sheets(1) 'on sauvegarde dans la 1re feuille
sChemin = ChoisirRepertoire & "\" 'fonction pour choisir le répertoire contenant les fichier Word
'sChemin = ThisWorkbook.Path & "\" 'si les fichiers Word se trouvent dans le même répertoire que le fichier Excel
sNomFichier = Dir(sChemin & "*.doc*") 'pour ouvrir tous les fichiers .doc*. 1er fichier.
Set WApp = CreateObject("Word.Application") 'pour créer un objet Word
WApp.Visible = True 'ne pas afficher Word pendant l'exécution
i = ws.Range("A" & Rows.Count).End(xlUp).Row + 1 '1re ligne où on va écrire les données dans le fichier Excel
Application.ScreenUpdating = False
' -- Boucle sur les fichiers
Do While Len(sNomFichier) > 0
Set WDoc = WApp.Documents.Open(sChemin & sNomFichier) 'ouvre le document Word
'Application.StatusBar = "Écriture ligne " & i 'message dans Excel pour voir la progression
' Nom du fichier
ws.Cells(i, 1) = sNomFichier
ws.Cells(i, 2) = findMe
' rechercher dans corps de texte, entête et pied de page
WApp.Selection.HomeKey Unit:=6 'Retourne au début du fichier Word
WApp.Selection.Find.ClearFormatting 'on "vide la mémoire" de la fonction Recherche
With WApp.Selection.Find
.Text = findMe
.Forward = True
.Format = False
'.Wrap = wdFindContinue
.MatchCase = True
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Motcletrouve = WApp.Selection.Find.Execute
If Motcletrouve = True Then
Cells(i, 3) = findMe & " trouvé"
Else
Cells(i, 3) = "RAS"
End If
i = i + 1 'prochaine ligne
WDoc.Close False 'fermer le document Word sans enregistrer
sNomFichier = Dir 'prochain document
Loop
SortieNormale:
Application.ScreenUpdating = True
WApp.Quit 'Fermer l'instance de Word
Application.StatusBar = False 'Remise à zéro de la barre d'état
Set wb = Nothing
Set ws = Nothing
Set WApp = Nothing
Set WDoc = Nothing
Set WSel = Nothing
Set WApp = Nothing
End Sub
'====================================
'Function to chose the folder containing the .doc files
'====================================
Function ChoisirRepertoire() As String
Dim oRepertoire As Object
ChoisirRepertoire = ""
Set oRepertoire = CreateObject("Shell.Application").BrowseForFolder(0, "Choisir un répertoire", 0)
If (Not oRepertoire Is Nothing) Then ChoisirRepertoire = oRepertoire.Items.Item.Path
Set oRepertoire = Nothing
End Function
