Sub GetWordFile()
    Dim oWd As Object, oDoc As Object, f As Boolean
    
    sfile = Application.GetOpenFilename( _
        FileFilter:="Word Files *.doc* (*.doc*),", _
        Title:="Browse to and open required word file.", _
        MultiSelect:=False)
    If sfile <> "False" Then
        On Error Resume Next
        Set oDoc = GetObject(sfile)
        On Error GoTo 0
        If oDoc Is Nothing Then
            Set oWd = GetObject(, "Word.Application")
            If oWd Is Nothing Then
                Set oWd = CreateObject("Word.Application")
                If oWd Is Nothing Then
                    MsgBox "Failed to start Word!", 16, "Word File Selection"
                    Exit Sub
                End If
                f = True
            End If
            Set oDoc = oWd.Documents.Open(sfile)
            If oDoc Is Nothing Then
                MsgBox "Failed to open selected document!", 16, "Word File Selection"
                If f Then
                    oWd.Quit
                End If
                Exit Sub
            End If
            oWd.Visible = True
        Else
            With oDoc.Parent
                .Visible = True
            End With
        End If
    Else
        Application.DisplayAlerts = 0
        MsgBox "No file selected.", 16, "Word File Selection"
        Application.DisplayAlerts = 1
    End If
End Sub

Sub PopulateWord()
    Dim x, y, i As Long, oDoc As Object, sKap As String, sFldText As String
    Set oDoc = GetObject(sfile)
    
    x = [tblMergefields]
    
    With oDoc
        .Bookmarks("Start").Range.Select
        .Activate
        With .Parent.Selection
            i = i + 1
            GetTextAndStyle CStr(x(i, 20))
            sFldText = "MERGEFIELD  " & x(i, 6) & " "
            .TypeText Text:=x(i, 20) & " " & sText
            .Style = oDoc.Styles(sStyle)
            .TypeParagraph
            .Fields.Add .Range, wdFieldEmpty, sFl, 1
            .Style = oDoc.Styles("Normal")
            .TypeParagraph
            i = i + 1
            GetTextAndStyle CStr(x(i, 20))
            .TypeText Text:=x(i, 20) & " " & sText
            .Style = .Parent.Styles(sStyle)
            .TypeParagraph
               ' further code that is a repeat of above to add further headings and fields
        End with
    End with

End Sub

Sub GetTextAndStyle(s As String)
    Dim x, i As Integer
    
    x = [tblKapitel]
    For i = 1 To UBound(x, 1)
        If x(i, 1) = s Then
            sText = x(i, 2)
            sStyle = UCase(x(i, 4))
            Exit For
        End If
    Next
    If i = UBound(x, 1) + 1 Then
        sText = x(i, 2)
        sStyle = "Normal"
    End If
    
End Sub

.Fields.Add .Range, wdFieldEmpty, sFl, 1

    Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _
        "MERGEFIELD  F111 ", PreserveFormatting:=True