Hallo DC,

Doch! - Die Funktion InQuotes gibt auch WAHR zurück, wenn der Müller allein in Anführungszeichen steht. Um das zu testen brauchst du nur den einzelnen Müller zwischen zwei Anführungszeichen markieren und ein kleines Testmakro ausführen:

Sub Test()
  MsgBox InQuotes(Selection.Range)
End Sub

 ...dass wenn die Wörter in "Anführungszeichen" gefunden wurden, die Suche weitergeht, bis sie im normalen Fleißtext stehen...

Dass das Makro bereits nach dem Ersten Fund außerhalb von Anführungszeichen abbricht, und du eine zusätzliche Schleife benötigst, wenn du mehrere korrekte Fundstellen im Dokument hast, hatte ich bereits in meinem ersten Post geschrieben. Den Code entsprechend umzuschreiben, und die Funkion in deine Schleife einzubauen, sollte eigentlich kein Problem für dich sein. Aber ich geb dir hier gern nochmal ein Beispiel:

Sub Finden()
 
    vTextFN = "Müller"
    s = -1
     
    With Selection.Find
        .Text = vTextFN
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        
        .Execute
        Do While .Found And .Parent.Start >= s
          If Not InQuotes(.Parent.Range) Then
            If s = -1 Then s = .Parent.Start
            'Selection.InsertFile FileName:=vTextEIN, link:=False
            t = Timer
            Do: Loop Until Timer >= t + 2 'Wartet 2 Sekunden bevor der Code weiterläuft.
          End If
          .Execute
          DoEvents 'erzwingt das Neuzeichnen des Bildschirms
        Loop
          
    End With
      
End Sub
Function InQuotes(rng As Range) As Boolean
   
  Dim drng As Range, t As String
  Set drng = ActiveDocument.Range
  Dim a As Long, a1 As Long, a2 As Long, a3 As Long, b As Long, b1 As Long, b2 As Long, b3 As Long, x As Byte
  a1 = InStrRev(drng.Text, Chr(34), rng.Start + 1)
  a2 = InStrRev(drng.Text, Chr(132), rng.Start + 1)
  a3 = InStrRev(drng.Text, Chr(147), rng.Start + 1)
  a = IIf(a2 > a1, a2, a1)
  a = IIf(a3 > a, 0, a)
  b1 = InStr(rng.Start + 1, drng.Text, Chr(34))
  b2 = InStr(rng.Start + 1, drng.Text, Chr(147))
  b3 = InStr(rng.Start + 1, drng.Text, Chr(132))
  b = IIf(b2 < b1 And b2 > 0 Or b1 = 0, b2, b1)
  b = IIf(b3 < b And b3 > 0, 0, b)
  If a > 0 Then
    t = drng.Characters(a).Next
    If t <> " " And t <> Chr(13) And t <> Chr(10) Then x = x + 1
  End If
  If b > 0 Then
    t = drng.Characters(b).Previous
    If t <> " " And t <> Chr(13) And t <> Chr(10) Then x = x + 1
  End If
   
  InQuotes = x = 2
   
End Function

Die Fundstellen werden automatisch durch .Execute markiert. Damit ist dein zweiter Thread überflüssig. In einer größeren Schleife kann es höchstens sein, dass diese Markierung nicht angezeigt wird, weil das ständige NeuZeichnen des Bildschirms in VBA zusätzliche Zeit kostet. Wenn man das Neuzeichnen erzwingen will, kann man ein DoEvents einbauen.

Das Makro funktioniert in Dokumenten mit normalen Fließtext sehr gut. Allerdings haben wir in einem anderen Thread festgestellt, dass eine ungünstige aufwendige Dokument-Formatierung zu falschen Ergebnissen führen kann. Leider habe ich absolut keine Idee, woran das liegen könnte, da ich das betreffende Echt-Dokument nicht kenne. Ein eventuelles Debuggen ist damit so gut wie unmöglich. Sag also mal bitte nochmal Bescheid, ob bei dir jetzt alles wie gewünscht funktioniert.

Gruß Mr. K.