Set db = CurrentDb
    sDocVorlage = CurrentProject.Path & "\NeueTabelle.dot"
    sDocName = CurrentProject.Path & "\Protokolle\DocNeueTabelle.doc"
    'Neue Instanz von Word aufrufen
    Set wdApp = CreateObject("Word.Application")
    With wdApp
        'Unsichtbar schalten
        .Visible = False
        'Aktivieren (nur bei Visible=True)
        '.Activate
           
        'Vorlage als Dokument öffnen
        .Documents.Add Template:=sDocVorlage
        'Name der aktiven Vorlage zwischenspeichern
        Set wdDoc = .ActiveDocument
        sVorlage = .ActiveDocument.Name
        
        'gesamtes Recordset als Text einlesen
        'Chr(1) = Trennzeichen
        Set rs = db.OpenRecordset("SELECT EreigDatum & Chr(1) As Tag, " _
            & "Uhrzeit & Chr(1) As Zeit, Ereignis " _
            & "FROM tblProtokolldaten ORDER BY EreigDatum, Uhrzeit")
        rs.MoveFirst
        If Not rs.BOF And Not rs.EOF Then
            'Feldnamen zuerst einlesen für Tabellenüberschrift
            anzS = 0
            For Each fld In rs.Fields
                sText = sText & rs.Fields(anzS).Name & Chr(1)
                anzS = anzS + 1
            Next fld
            rs.MoveLast
            anzZ = rs.RecordCount + 1
            
            'letztes Trennzeichen wieder abschneiden und Zeilenumbruch anfügen,
            'womit die Überschrift gleichzeitig als erster Datensatz fungiert
            sText = Left$(sText, Len(sText) - 1) & vbCrLf
            rs.MoveFirst
            Do While Not rs.EOF             'Daten aus dem Recordset einlesen
                i = 0
                For Each fld In rs.Fields
                'ohne Trennzeichen, da dies bereits im Recordset als Feldtrennung
                'eingebaut ist
                sText = sText & rs.Fields(i).Value
                i = i + 1
                Next fld
                sText = sText & vbCrLf      'Zeilenumbruch nach jedem Datensatz
                rs.MoveNext
            Loop
        Else
            MsgBox "Keine Daten"
        End If
        'Tabellenposition an Textmarke 'NeueTabelle1'
        Set wdRange = .ActiveDocument.Range(.ActiveDocument.Bookmarks("NeueTabelle1").Start, _
            .ActiveDocument.Bookmarks("NeueTabelle1").End)
        wdRange = sText                     'Zuweisung des Textes an den Range
        
        'Erstellen der Tabelle mit Tabellen-Autoformat 'Liste3'
        wdRange.ConvertToTable Separator:=Chr(1), NumRows:=anzZ, NumColumns:=anzS, _
            InitialColumnWidth:=70, Format:=wdTableFormatList3, ApplyBorders:=True
        'Anpassung Spaltenbreiten
        .ActiveDocument.Tables(1).Columns(2).Width = 60
        .ActiveDocument.Tables(1).Columns(3).Width = 310
        rs.Close
        'Namen des aktiven Dokuments der Variablen zuweisen
        sAktiv = .ActiveDocument.Name
        'Dokument speichern
        With wdApp.Documents(sAktiv)
'hier könnte eine Hinweisfenster kommen ob man die Datei öffnen möchte oder nur Speichern
            .SaveAs FileName:=sDocName
            .[blue]Close
'            .Add DocumentType:=wdDocument
        End With
    End With