Bonjour,

Je vous contacte car j'ai (re) "bidouiller" quelque chose.. qui évidemment ne fonctionne pas terrible

l'idée est d'ouvrir un premier doc word contenu dans un dossier (dont le chemin d'accès est spécifié dans une cellule de mon Excel)
puis de vérifier le nombre d'occurence d'un premier mot
puis de renseigner ce décompte dans une cellule spécifique du tableau de suivi des occurences du document word
et de passer au prochain doc word

mon premier problème est que je mélange des concepts (ce qui ne passe pas en VBA) et génère une erreur ici :

code :

Workbooks.Open Filename:=ThisWorkbook.Sheets("Macros").Range("I16").Value & "\" & ThisWorkbook.Sheets("Liste des docs words analysés").Cells(j, 1).Value

mon second problème est que je voudrais récupérer les 18 derniers caractères précédent le ".docx" sachant qu'à ce stade (lorsque la boucle fonctionnait un minimum) étaient pris en compte le document pdf associé à ce même word (que je garde dans le même dossier)..

Je remercie par avance l'âme généreuse qui daignera m'apporter son aide.

Voici mon code

Code :

Sub Compter()

Dim n As Integer
n = ThisWorkbook.Sheets("Wordings").Cells(1, 10000).End(xlToLeft).Column

Dim k As Integer
k = ThisWorkbook.Sheets("Liste des docs words analysés").Cells(60000, 1).End(xlUp).Row

Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Macros")

Dim word_path As String
word_path = sh.Range("I16").Value

Dim fso As New FileSystemObject
Dim fo As Folder
Dim f As File
Dim WordApp As Word.Application
Dim doc As Object

Dim wa As Object
Set wa = CreateObject("Word.Application")

Set fo = fso.GetFolder(word_path)
Dim file_count As Integer

Count = 0

For i = 7 To n

For j = 1 To k

file_count = 0

For Each f In fo.Files
Application.DisplayAlerts = False
'Set doc = wa.Documents.Open(f.Path, ReadOnly = True)

Workbooks.Open Filename:=ThisWorkbook.Sheets("Macros").Range("I16").Value & "\" & ThisWorkbook.Sheets("Liste des docs words analysés").Cells(j, 1).Value

searchtext$ = Sheets("Wordings").Cells(1, i).Value

With doc.Content.Find
Do While .Execute(findText:=searchtext$, Format:=False, MatchCase:=False, MatchWholeWord:=True) = True
Count = Count + 1
Loop
End With

Dim zed As Integer
zed = ThisWorkbook.Sheets("Wordings").Cells(60000, 7).End(xlUp).Row

ThisWorkbook.Sheets("Wordings").Cells(zed + 1, i).Value = Count
ThisWorkbook.Sheets("Wordings").Cells(zed + 1, 5).Value = Right(ActiveDocument.doc, 18)

doc.Close True

Next

Next j

Next i