Sub recherchedansword()
Dim Cible As String
Dim AppWord As Word.Application
Dim DocWord As Word.Document
Dim CollWord As Word.Words
Dim x As Long, a As String, b As String
Cible = "C:\Users\René\Downloads\docx dwld.docx"
'Ouvre une instance Word
Set AppWord = New Word.Application
'Indiquez False pour garder l'application masquée
AppWord.Visible = True
'Ouvre le document Word
Set DocWord = AppWord.Documents.Open(Cible)
Set CollWord = DocWord.Content.Words
'Boucle sur les mots du document
For x = 1 To CollWord.Count - 2
If InStr(1, CollWord(x) & CollWord(x + 1), "Dossier") > 0 Then
a = CollWord(x + 4)
End If
If InStr(1, CollWord(x) & CollWord(x + 1), ",") > 0 Then
b = CollWord(x + 3) & CollWord(x + 4) & CollWord(x + 5) & CollWord(x + 6) & CollWord(x + 7)
End If
'résultat dans feuille
If a <> "" And b <> "" Then
l = l + 1
Range("E" & l) = a: Range("F" & l) = b
Exit For
End If
Next
DocWord.Close True
Set DocWord = Nothing
AppWord.Quit
Set AppWord = Nothing
End Sub