Access To Word Form Using VBA

Hello I am very new with VBA.

I have this code that populates data in a word form, From access table

But it is populating all the records in  the form. I have a word form template.

I want to make it work in a way so it can populate all the records for one employee in one form and when the employee name changes it should go to new page. Also print all the document. always over 500 records.

Please help.

Private Sub cmdPrint_Click()
'Print customer slip for current customer.
Dim ObjWord As Word.Application
Dim doc As Word.Document
Dim bolCreated As Boolean
Dim strPath As String
Dim lngInStr As Long
Dim db As Database
Dim rst As Recordset
Dim Recordset As Field
'Avoid error 429, when Word isn't open.
On Error Resume Next
Err.Clear
'Set appWord object variable to running instance of Word.
Set ObjWord = GetObject(, "Word.Application")
If Err.Number <> 0 Then
'If Word isn't open, create a new instance of Word.
 Set ObjWord = CreateObject("Word.Application")
 bolCreated = True
End If

ObjWord.Visible = True
'Get Path of Current DB
strPath = CurrentDb().Name
'Strip FileName to Get Path to Doc
'Populate recordset object.
'Strip FileName to Get Path to Doc
Do
    lngInStr = InStr(lngInStr + 1, strPath, "\")
Loop While (InStr(lngInStr + 1, strPath, "\") <> 0)
'Get path up to the last '\'
strPath = Left(strPath, lngInStr)
'Append document name onto the end of the stripped path
strPath = strPath & "TSA_Form_1107b.doc"
'Open Document
Set doc = ObjWord.Documents.Open(strPath)
Set db = CurrentDb()
Set rst = db.OpenRecordset("1107bCalculatedHours")

'Set rst = New ADODB.Recordset
'rst.Open Me.RecordSource, CurrentProject.Connection
'Cycle through records to fill Word form fields.
Do While Not rst.EOF
Set doc = ObjWord.Documents.Open(strPath)
With doc
'.FormFields("fldCustomerID").Result = rst!CustomerID
'.FormFields("fldCompanyName").Result = rst!CompanyName
'.FormFields("fldContactName").Result = rst!ContactName
'.FormFields("fldContactTitle").Result = rst!ContactTitle
'.FormFields("fldAddress").Result = rst!Address
'.FormFields("fldCity").Result = rst!City
'.FormFields("fldRegion").Result = rst!Region
'.FormFields("fldPostalCode").Result = rst!PostalCode
'.FormFields("fldCountry").Result = rst!Country
'.FormFields("fldPhone").Result = rst!Phone
'.FormFields("fldFax").Result = rst!Fax
doc.Bookmarks("Name").Select
    ObjWord.Selection.TypeText rst.Fields("Emp Name")
doc.Bookmarks("DateOfOT").Select
    ObjWord.Selection.TypeText rst.Fields("DateOfOT")
      doc.Bookmarks("HoursWorked").Select
    ObjWord.Selection.TypeText rst.Fields("HoursWorked")
      doc.Bookmarks("OTAnomalies").Select
    ObjWord.Selection.TypeText rst.Fields("OT Anomaly")
    doc.Bookmarks("OTShiftTime").Select
    ObjWord.Selection.TypeText rst.Fields("OTShiftTime")
      doc.Bookmarks("HoursWorked2").Select
    ObjWord.Selection.TypeText rst.Fields("HoursWorked")
.Visible = True
.Activate
'.PrintOut
'.SaveAs "'" & rst!CustomerID & "'"
rst.MoveNext
End With
Loop
Set doc = Nothing
Set ObjWord = Nothing
Exit Sub
errHandler:
MsgBox Err.Number & ": " & Err.Description
End Sub

Private Sub Command6_Click()
Me.WeekStartDate.Value = ""
Me.WeekEndDate.Value = ""
End Sub

Thanks in Advance