Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As _
  System.EventArgs) Handles Button1.Click
 
        Dim Dateiname As String
        Dim pfad_vorlage As String
 
        pfad_vorlage = "C:\Dokumente und Einstellungen\tereza&blas\Eigene" & _
          "Dateien\QTA-Vorlage\Außendienst\"
 
        Dim appWord As Object
        Dim doc As Object
        appWord = CreateObject("Word.Application")
        appWord.Visible = True
 
 
 
        Dim Datum As String
        Dim Zeit As String
 
        Datum = Date.Today
        Zeit = TimeOfDay
 
 
        doc = appWord.Documents.Add
 
        With doc
 
            'Text im Hauptteil des Dokuments zuweisen
            .Range.Text = "Notiz" & vbCrLf & vbCrLf & _
                    "Fa.: " & TextBox1.Text & vbCrLf & _
                    "Ansprechpartner: " & TextBox2.Text
 
 
            'Kopfzeilen-Text zuweisen
            '.Sections(1).Headers(wdHeaderFooterPrimary).Range.Text = _
            '      "Telefonnotiz vom " & Format$(Now, "Long Date") & "/" & 
            ' TextBox17.Text
 
            'Fusszeilen-Text zuweisen
            '.Sections(1).Footers(wdHeaderFooterPrimary).Range.Text = _
            '      "Erstellt am " & Format$(Now, "Long Date")
 
        End With
 
        'ActiveDocument.ResetAllPageBreaks
 
        'zu Seite 1 gehen
        'Selection.GoTo(wdGoToPage, wdGoToAbsolute, 1)
 
        'Anschreiben einfügen mit Namen aus Anrede
        Call DateiEinfuegen(doc:=ActiveDocument, strDatei:=pfad_vorlage & _
          "AnschreibenPP.doc", strTMName:="Anrede")
        If ActiveDocument.Bookmarks.Exists("Anrede_Ansprechpartner") Then
            ActiveDocument.Bookmarks("Anrede_Ansprechpartner").Range.Text = Mid( _
              ActiveDocument.Bookmarks("Anrede").Range.Text, 30, 15)
        End If
 
 
        'Verbindungen beenden
        doc = Nothing
        appWord = Nothing
 
    End Sub
 
    'Datei einfügen in Textmarke
    Sub DateiEinfuegen(ByVal doc As Word.Document, ByVal strDatei As String, _
      ByVal strTMName As String)
        Dim rngTM As Word.Range
        Dim rng As Word.Range
 
        If doc.Bookmarks.Exists(strTMName) Then
            rngTM = doc.Bookmarks(strTMName).Range
            rng = doc.Bookmarks(strTMName).Range.Duplicate
            rng.MoveEnd(wdCharacter, 1)
            If rng.InlineShapes.Count > 0 Then
                rng.InlineShapes(1).Delete()
            End If
            With rngTM
                .Collapse(wdCollapseEnd)
                .InsertFile(FileName:=strDatei)
            End With
        End If
        rngTM = Nothing
        rng = Nothing
 
    End Sub