[dim.konst]

Τελικά ψάχνοντας στο ιντερνετ βρήκα λύση που με κάποιες μετατροπές με καλύπτει. Ίσως δεν είναι η καλύτερη λύση αλλά μου έλυσε το πρόβλημα, ανεβάζω τον κώδικα για όποιον αντιμετωπίσει παρόμοιο πρόβλημα.

Private Sub FindInDoc
Dim wApp As Word.Application
Dim mySource As Object
Dim oDoc As Object
Const wdYellow = 7
Dim rng1 As Range
Dim strTheText As String
Dim metr, metr2 As Integer

strTheText = InputBox("Δώσε Επώνυμο για ψάξιμο μέσα στα έγγραφα του φακέλου TEST_WORD")
DoCmd.Hourglass True
If Len(strTheText) < 2 Then
DoCmd.Hourglass False
Exit Sub
End If
Set obj = CreateObject("Scripting.FileSystemObject")
Set mySource = obj.GetFolder("D\TEST_WORD")

For Each file In mySource.Files 'loop through the directory
If Len(file.Name) > 0 And InStr(1, file.Name, "$") = 0 Then
Set wApp = CreateObject("Word.Application")
Set oDoc = wApp.Documents.Open(mySource & "\" & file.Name)
oDoc.Content.Find.HitHighlight FindText:=strTheText
Set rng1 = oDoc.Range
If rng1.Find.Execute(FindText:=strTheText) Then
wApp.Visible = True
AnswerVRE = MsgBox( " ΒΡΈΘΗΚΕ - ΘΈΛΕΤΕ ΝΑ ΣΥΝΕΧΊΣΕΤΕ ΤΟ ΨΆΞΙΜΟ", vbYesNo + vbQuestion + vbDefaultButton1, "ΕΠΙΛΈΞΤΕ;")
If AnswerVRE = vbNo Then
DoCmd.Hourglass False
Exit Sub
End If
End If
On Error Resume Next
wApp.Quit
Set wApp = Nothing
End If
Next file
DoCmd.Hourglass False
MsgBox "Τέλος "
End Sub