Create Letters.doc in word with bookmarks in excel

Option Explicit
Sub MailMerge()
'Word application objects declaration
' Important:
' Set Reference (Tools menu) to Microsoft Word nn.n Object Library
Dim oApp      As Word.Application
Dim oDoc      As Word.Document
Dim oTemplate As Word.Document
Dim oBookMark As Word.Bookmark
 On Error GoTo HandleError
' Excel application objects declaration
Dim wb As Workbook
Dim ws As Worksheet
Dim wsControl As Worksheet
Dim rng As Range
Dim rng2 As Range
Dim objX As Object
Dim strDocName As String
Dim strPathName As String
Dim lngKount As Long
Dim lngRecordKount As Long
Dim strFileName As String
'
     Application.ScreenUpdating = False
     Set wb = ThisWorkbook
     Set ws = wb.Worksheets("Merge Data")
     Set wsControl = wb.Worksheets("Control Sheet")
'Set data range
    ' Records in Column A, excluding heading
     Set rng = ws.Range(ws.Cells(2, 1), ws.Cells(65536, 1).End(xlUp))
     lngRecordKount = rng.Rows.Count
' Get location of WORD document:
     strPathName = wsControl.Range("B1").Value
     strDocName = wsControl.Range("B2").Value
     If ((strDocName = "") Or (strDocName = " ")) Then
        ' use document with same name as this workbook:
         strDocName = Left(wb.Name, Len(wb.Name) - 4) & ".doc"
     End If
     If ((strPathName = "") Or (strPathName = " ")) Then
         ' use same path as this workbook:
         strPathName = wb.Path
     End If
     strFileName = strPathName & "\" & strDocName
' Check that file exists:
     If Dir(strFileName) = "" Then
         MsgBox strFileName & vbCrLf & "cannot be found", vbOKOnly + vbCritical, "Error"
                GoTo HandleExit
    End If
'Create new word application
     Application.StatusBar = "Starting Microsoft Word"
     Set oApp = CreateObject("Word.Application")
'Create new document
     Application.StatusBar = "Creating new Word Document"
     Set oDoc = oApp.Documents.Add
'Loop in data range
     lngKount = 1
     For Each rng2 In rng.Cells
         Application.StatusBar = "Creating document " & lngKount & " of " & lngRecordKount
        'Insert requested file/template into the main document
         oApp.Selection.InsertFile strFileName
        'Find all bookmarks and replace with data:
         For Each oBookMark In oDoc.Bookmarks
             'Corresponding header found in first row ?
             Set objX = ws.Rows(1).Find(oBookMark.Name, LookIn:=xlValues, LookAt:=xlWhole)
             If Not objX Is Nothing Then
                ' heading found for bookmark
                 oBookMark.Range.Text = rng2.Offset(, objX.Column - 1).Value
            Else
                 MsgBox "Error - Bookmark '" & oBookMark.Name & "' not found in " & vbCrLf & _
                    "[" & wb.Name & "]!" & wsControl.Name & vbCrLf & vbCrLf & _
                    "Please check that all bookmarks exist as headings", vbOKOnly, "Bookmark Error"
                 oApp.Quit
                 GoTo HandleExit
            End If
        Next oBookMark
        'Goto next page
        'wdPageBreak = 7
         oApp.Selection.InsertBreak 7
         lngKount = lngKount + 1
    Next rng2
'
    MsgBox "Process complete - please check result", vbOKOnly + vbInformation, "Merge Complete"
    oApp.Visible = True
HandleExit:
     On Error Resume Next
     Application.StatusBar = ""
     Application.ScreenUpdating = True
     Set oDoc = Nothing
     Set oTemplate = Nothing
     Set oBookMark = Nothing
     Set wb = Nothing
     Set ws = Nothing
     Set wsControl = Nothing
     Set rng = Nothing
     Set rng2 = Nothing
     Set objX = Nothing
'
    Set oApp = Nothing
'
    Exit Sub
'
HandleError:
    ' Do something here?
    Resume HandleExit
End Sub

If Right(oBookMark.Name, 4) = "Date" Then
	oBookMark.Range.Text = Format(cll.Offset(, fnd.Column - 1).Value, "dd mmmm yyyy")
ElseIf Right(oBookMark.Name, 4) = "Rate" Then
	oBookMark.Range.Text = Format(cll.Offset(, fnd.Column - 1).Value, "0.00%")
ElseIf Right(oBookMark.Name, 7) = "Payment" Then
	oBookMark.Range.Text = Format(cll.Offset(, fnd.Column - 1).Value, "£#,##0.00")
ElseIf Right(oBookMark.Name, 6) = "Amount" Then
	oBookMark.Range.Text = Format(cll.Offset(, fnd.Column - 1).Value, "£#,##0.00")
Else
	oBookMark.Range.Text = cll.Offset(, fnd.Column - 1).Value
End If

oApp.Application.PrintOut Copies:=1
            .Close savechanges:=False