Private Sub cmdRptDatesOk_Click()
On Error GoTo Err_cmdRptDatesOk_Click
Dim dbs As DAO.Database
Dim rstRd As DAO.Recordset
Dim rstRep As DAO.Recordset
Dim strQryDef As String
Dim stDocName As String
Dim stLinkCriteria As String
Dim lngEmp As Long
Dim dtmMaxCal As Date
' Identify maximum date in tblCalendar
dtmMaxCal = DMax("[dtmCalDate]", "tblCalendar")
' Set the connection
Set dbs = CurrentDb
Set rstRd = dbs.OpenRecordset("tblReportingDates")
Set rstRep = dbs.OpenRecordset("tblReporting")
' Verify that critical fields have valid entries
If IsNull(Me.txtRptStart) Or Me.txtRptStart = "" Then
MsgBox "You must enter the start date for the report.", vbOKOnly, "Data required"
Me.txtRptStart.SetFocus
Exit Sub
End If
If IsNull(Me.txtRptEnd) Or Me.txtRptEnd = "" Then
MsgBox "You must enter the end date for the report.", vbOKOnly, "Data required"
Me.txtRptEnd.SetFocus
Exit Sub
End If
' Identify whether the dates are beyond the limit of the calendar
If Me.txtRptStart > dtmMaxCal Then
MsgBox "The date you have entered is not yet added to the calendar. Please check date.", vbOKOnly, "Data required"
Me.txtRptStart.SetFocus
Exit Sub
End If
If Me.txtRptEnd > dtmMaxCal Then
MsgBox "The date you have entered is not yet added to the calendar. Please check date.", vbOKOnly, "Data required"
Me.txtRptEnd.SetFocus
Exit Sub
End If
' Reveal wait message
Me.lblWait.Visible = True
Me.Repaint
' Clear down any hours in tblStaffDays where holidays are booked for a Public Holiday
DoCmd.SetWarnings False
strQryDef = "qupdSdPhHol"
DoCmd.OpenQuery strQryDef
DoCmd.SetWarnings True
' Clear down any hours in tblActual where holidays are booked for a Public Holiday
DoCmd.SetWarnings False
strQryDef = "qupdActualPhHol"
DoCmd.OpenQuery strQryDef
DoCmd.SetWarnings True
'' Mark up taken holidays
DoCmd.SetWarnings False
strQryDef = "qupdSdHolTak"
DoCmd.OpenQuery strQryDef
DoCmd.SetWarnings True
' Delete any extant records in tblTmpReportDates
dbs.Execute "DELETE * FROM tblReportingDates"
' Update dates from this form to tblReportingDates
rstRd.AddNew
rstRd!dtmStart = Me.txtRptStart
rstRd!dtmEnd = Me.txtRptEnd
rstRd.Update
' Delete any extant records in tblReporting
dbs.Execute "DELETE * FROM tblReporting"
' Update tblReporting so that all active employees are shown
DoCmd.SetWarnings False
strQryDef = "qappRptActStaff"
DoCmd.OpenQuery strQryDef, acViewNormal, acEdit
DoCmd.SetWarnings True
' Update the fields in tblReporting - need to sort!!!!
rstRep.MoveFirst
Do While rstRep.EOF = False
lngEmp = rstRep!lngEmpId
rstRep.Edit
rstRep!dtmRptStart = Me.txtRptStart
rstRep!dtmRptEnd = Me.txtRptEnd
rstRep!dblHolAllowance = DLookup("dblEmpHolAl", "tblStaff", "[lngEmpId]= " & lngEmp & "")
rstRep!dblHolServRel = DLookup("dblEmpSrHol", "tblStaff", "[lngEmpId]= " & lngEmp & "")
rstRep!dblHolPubHol = DLookup("dblEmpPhHol", "tblStaff", "[lngEmpId]= " & lngEmp & "")
rstRep!dblHolAll = DLookup("dblEmpHolAl", "tblStaff", "[lngEmpId]= " & lngEmp & "")
rstRep!dblHolTak = DLookup("[SumHolTaken]", "qsumHolTaken", "[lngActEmp]= " & lngEmp & "")
rstRep!dblHolBook = DLookup("[SumHolBook]", "qsumHolBooked", "[lngEmpNo]= " & lngEmp & "")
rstRep!dblAuthAbs = DLookup("[SumAuthAbs]", "qsumAuthAbs", "[lngActEmp]= " & lngEmp & "")
rstRep!dblAccTak = DLookup("[SumAccTaken]", "qsumAccTaken", "[lngActEmp]= " & lngEmp & "")
rstRep!dblCol = DLookup("[SumColl]", "qsumColl", "[lngActEmp]= " & lngEmp & "")
rstRep!dblIll = DLookup("[SumIll]", "qsumIll", "[lngActEmp]= " & lngEmp & "")
rstRep!dblAcc = DLookup("[SumAccDue]", "qsumAccDue", "[lngActEmp]= " & lngEmp & "")
rstRep.Update
rstRep.MoveNext
Loop
' Set all null values to 0 in tblReporting
DoCmd.SetWarnings False
strQryDef = "qupdRpt1"
DoCmd.OpenQuery strQryDef, acViewNormal, acEdit
DoCmd.SetWarnings True
DoCmd.SetWarnings False
strQryDef = "qupdRpt2"
DoCmd.OpenQuery strQryDef, acViewNormal, acEdit
DoCmd.SetWarnings True
DoCmd.SetWarnings False
strQryDef = "qupdRpt3"
DoCmd.OpenQuery strQryDef, acViewNormal, acEdit
DoCmd.SetWarnings True
DoCmd.SetWarnings False
strQryDef = "qupdRpt4"
DoCmd.OpenQuery strQryDef, acViewNormal, acEdit
DoCmd.SetWarnings True
DoCmd.SetWarnings False
strQryDef = "qupdRpt5"
DoCmd.OpenQuery strQryDef, acViewNormal, acEdit
DoCmd.SetWarnings True
DoCmd.SetWarnings False
strQryDef = "qupdRpt6"
DoCmd.OpenQuery strQryDef, acViewNormal, acEdit
DoCmd.SetWarnings True
DoCmd.SetWarnings False
strQryDef = "qupdRpt7"
DoCmd.OpenQuery strQryDef, acViewNormal, acEdit
DoCmd.SetWarnings True
DoCmd.SetWarnings False
strQryDef = "qupdRpt8"
DoCmd.OpenQuery strQryDef, acViewNormal, acEdit
DoCmd.SetWarnings True
' Close the form
stDocName = "frmReportingDates"
DoCmd.Close acForm, stDocName, acSaveNo
' Open the form
stDocName = "frmAttendance"
DoCmd.OpenForm stDocName, , , stLinkCriteria
Exit_cmdRptDatesOk_Click:
rstRd.Close
rstRep.Close
Set rstRd = Nothing
Set rstRep = Nothing
Set dbs = Nothing
stDocName = vbNullString
strQryDef = vbNullString
Exit Sub
Err_cmdRptDatesOk_Click:
MsgBox Err.Description
Resume Exit_cmdRptDatesOk_Click
End Sub