Sub BookmarkSetter()
Dim appWD As Object
Dim objXL As Object
Dim zeilenzahl As Integer
Dim Path As String
Dim j As Integer
Dim i As Integer
Dim aktRange As Range
Dim doc
Dim textmarke As String
Dim suchen As String
Dim inhalt
zeilenzahl = 6
Do Until ActiveWorkbook.Worksheets("Tabelle1").Cells(zeilenzahl, 2).Value = ""
zeilenzahl = zeilenzahl + 1
Loop
zeilenzahl = zeilenzahl - 1
MsgBox zeilenzahl
For i = 1 To 1
suchen = ActiveWorkbook.Worksheets("Tabelle1").Cells(5 + i, 5).Value
textmarke = ActiveWorkbook.Worksheets("Tabelle1").Cells(5 + i, 2).Value
Set appWD = CreateObject("Word.Application")
appWD.Visible = True
Path = Worksheets("Tabelle1").Cells(5 + i, 3) & "\" & Worksheets("Tabelle1").Cells(5 + i, 4)
Set doc = appWD.Documents.Open(Path)
For Each absatz In doc.paragraphs
If Len(absatz) > 2 Then inhalt = Left(absatz, Len(absatz) - 1)
If inhalt = suchen And absatz.OutlineLevel = 2 Then
absatz.Range.Select
doc.Bookmarks.Add Name:=textmarke
End If
Next absatz
Next
End Sub