Über Excel VBA Word Dokument befüllen

Sub WordDokumentöffnen() 'ByVal Dokumente As String
Const wdReplaceAll = 2
Const wdNoProtection = -1
Dim oAppWD As Object, oDoc As Object
Dim Trennpunkt As Long
Dim Laenge As Long
Dim Unterschied As Long
Trennpunkt = InStr(1, ActiveWorkbook.Sheets("Eingabefenster").Range("B18").Value, " ")
Laenge = Len(ActiveWorkbook.Sheets("Eingabefenster").Range("B18").Value)
Unterschied = Laenge - Trennpunkt
If Dir("Dokumente")  "" Then
Set oAppWD = CreateObject("Word.Application") 'Word als Object starten
If Not oAppWD Is Nothing Then
oAppWD.Visible = True
If oAppWD.Options.AllowReadingMode = True Then 'Word nicht im Lesemodus starten bei  _
Schreibgeschützten Dokumenten
oAppWD.Options.AllowReadingMode = False
End If
Set oDoc = oAppWD.Documents.Open("Dokument")
Application.DisplayAlerts = False
If Not oDoc Is Nothing Then
If oDoc.ProtectionType  wdNoProtection Then oDoc.Unprotect
With oDoc.Range.Find
.Text = "Auftragsnr. xxx"
.MatchCase = True
.Replacement.Highlight = True
.Replacement.Text = "Auftragsnr. " & Left(ActiveWorkbook.Sheets("Eingabefenster") _
_
_
_
.Range("B18").Value, Trennpunkt)
.Execute Replace:=wdReplaceAll
End With
With oDoc.Range.Find
.Text = "Auftrag xxx"
.MatchCase = True
.Replacement.Highlight = True
.Replacement.Text = (ActiveWorkbook.Sheets("Variablen").Range("D2").Value)
.Execute Replace:=wdReplaceAll
End With
With oDoc.Range.Find
.Text = "XXX"
.MatchCase = True
.Replacement.Highlight = True
.Replacement.Text = "Dieser Text gilt nur als Test"
.Execute Replace:=wdReplaceAll
End With
oDoc.Save         'Dokument speichern
oDoc.Close        'Dokument schließen
oAppWD.Quit       'Word schließen
End If
End If
Else
MsgBox "Die zu öffnende Dokumentdatei wurde nicht gefunden!", vbCritical, "Word-Datei öffnen" _
_
_
_
End If
Set oAppWD = Nothing
Set oDoc = Nothing
End Sub