Set excel = CreateObject("excel.application")
excel.Workbooks.Open FileName:=pfadUrkunden
Dim wdDocument As Object
Dim Word As Object
Set Word = CreateObject("Word.Application")
Do While excel.Worksheets("TN").Cells(iIndex, 1).Value <> ""
sName = excel.Worksheets("TN").Cells(iIndex, 1).Value
Set wdDocument = Word.Documents.Add(vorlagePfad)
Word.Visible = True
Word.Activate
ActiveDocument.Shapes.Range(Array("Textfeld 2")).Select
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "[Vorname Nachname]"
.Replacement.Text = sName
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
ausgabeOrdner = ausgabeOrdner & "\" & sName
wdDocument.SaveAs (ausgabeOrdner)
iIndex = iIndex + 55
Loop
Word.Quit
Set Word = Nothing
excel.Quit