Public Enum TimeType
CoreStart = 1
CoreEnd = 2
UnsocialStart = 3
UnsocialEnd = 4
End Enum
Public Function GetTime(staffGroup As String, dtmDate As Date, WhatTime As TimeType)
Dim fieldName As String
Dim strSql As String
Dim rs As DAO.Recordset
Select Case WhatTime
Case CoreStart
fieldName = "StartCoreTime"
Case CoreEnd
fieldName = "EndCoreTime"
Case UnsocialStart
fieldName = "StartUnsocialTime"
Case UnsocialEnd
fieldName = "EndUnsocialTime"
End Select
'Need to account for the effective date
strSql = "Select TOP 1 * from tblTimeStatus WHERE StaffGroup = '" & staffGroup & "' AND AppliedDate <= #" & Format(dtmDate, "mm/dd/yyyy") & "#"
strSql = strSql & " ORDER BY AppliedDate DESC"
Set rs = CurrentDb.OpenRecordset(strSql)
GetTime = rs.Fields(fieldName)
End Function
Public Function isHoliday(dtmDate As Date) As Boolean
If DCount("*", "tblBankHolidays", "HolidayDate = #" & Format(dtmDate, "mm/dd/yyyy") & "#") > 0 Then isHoliday = True
End Function
Public Sub CreateShiftDetails()
Dim rs As DAO.Recordset
Dim strSql As String
Dim RequestID As Long
Dim requestDate As Date
Dim ShiftStart As Date
Dim shiftEnd As Date
Dim shift2Start As Date
Dim shift2End As Date
Dim staffGroup As String
Dim CoreStart As Date
Dim CoreEnd As Date
Dim UnsocialStart As Date
Dim UnsocialEnd As Date
Dim ShiftID1 As String
Dim shiftID2 As String
Dim CheckHoliday As Boolean
Dim rollover As Boolean
Set rs = CurrentDb.OpenRecordset("tblShiftRequests")
Do While Not rs.EOF
RequestID = rs!RequestID
requestDate = rs!requestDate
ShiftStart = rs!ShiftStart
shiftEnd = rs!shiftEnd
staffGroup = rs!staffGroup
rollover = shiftEnd < ShiftStart 'moves into next day
'check the first day
CoreStart = GetTime(staffGroup, requestDate, TimeType.CoreStart)
CoreEnd = GetTime(staffGroup, requestDate, TimeType.CoreEnd)
UnsocialStart = GetTime(staffGroup, requestDate, TimeType.UnsocialStart)
UnsocialEnd = GetTime(staffGroup, requestDate, TimeType.UnsocialEnd)
If isHoliday(requestDate) Then
ShiftID1 = "BankHoliday"
ElseIf Weekday(requestDate) = vbSaturday Then
ShiftID1 = "Saturday"
ElseIf Weekday(requestDate) = vbSunday Then
ShiftID1 = "Sunday"
Else
ShiftID1 = "Daily"
End If
If rollover Then
'if roll over break up into two dates
shift2End = shiftEnd
shiftEnd = #11:59:59 PM#
shift2Start = #12:00:01 AM#
If isHoliday(requestDate + 1) Then
shiftID2 = "BankHoliday"
ElseIf Weekday(requestDate + 1) = vbSaturday Then
shiftID2 = "Saturday"
ElseIf Weekday(requestDate + 1) = vbSunday Then
shiftID2 = "Sunday"
Else
shiftID2 = "Daily"
End If
InsertShifts RequestID, requestDate, CoreStart, CoreEnd, UnsocialStart, UnsocialEnd, ShiftStart, shiftEnd, ShiftID1
'break up the rollover and treat as a second day
InsertShifts RequestID, requestDate + 1, CoreStart, CoreEnd, UnsocialStart, UnsocialEnd, shift2Start, shift2End, shiftID2
Else
'does not rollover
InsertShifts RequestID, requestDate, CoreStart, CoreEnd, UnsocialStart, UnsocialEnd, ShiftStart, shiftEnd, ShiftID1
End If
rs.MoveNext
Loop
End Sub
Public Sub InsertShifts(RequestID As Long, requestDate As Date, CoreStart As Date, CoreEnd As Date, UnsocialStart As Date, UnsocialEnd As Date, ShiftStart As Date, shiftEnd As Date, ShiftID As String)
Dim strSql As String
If Not ShiftID = "Daily" Then
strSql = "Insert into TblShiftDetails (ParentRequestID, StartStatus, EndStatus,Status) values (" & RequestID & ", #" & requestDate + ShiftStart & "#, #" & requestDate + shiftEnd & "#, '" & ShiftID & "')"
CurrentDb.Execute strSql
Else
'case 1 all time inside core
If ShiftStart >= CoreStart And shiftEnd <= CoreEnd Then
strSql = "Insert into TblShiftDetails (ParentRequestID, StartStatus, EndStatus,Status) values (" & RequestID & ", #" & requestDate + ShiftStart & "#, #" & requestDate + shiftEnd & "#, 'DailyCore')"
'Debug.Print strSql
CurrentDb.Execute strSql
'case 2 starts in core and goes into unsocial
ElseIf ShiftStart >= CoreStart And ShiftStart <= CoreEnd And shiftEnd > CoreEnd Then
strSql = "Insert into TblShiftDetails (ParentRequestID, StartStatus, EndStatus,Status) values (" & RequestID & ", #" & requestDate + ShiftStart & "#, #" & requestDate + CoreEnd & "#, 'DailyCore')"
'Debug.Print strSql
CurrentDb.Execute strSql
strSql = "Insert into TblShiftDetails (ParentRequestID, StartStatus, EndStatus,Status) values (" & RequestID & ", #" & requestDate + UnsocialStart & "#, #" & requestDate + shiftEnd & "#, 'DailyUnsocial')"
'Debug.Print strSql
CurrentDb.Execute strSql
'case 3 starts before core and ends in core
ElseIf ShiftStart < CoreStart And shiftEnd > CoreStart And shiftEnd < CoreEnd Then
strSql = "Insert into TblShiftDetails (ParentRequestID, StartStatus, EndStatus,Status) values (" & RequestID & ", #" & requestDate + ShiftStart & "#, #" & requestDate + UnsocialEnd & "#, 'DailyUnsocial')"
'Debug.Print strSql
CurrentDb.Execute strSql
strSql = "Insert into TblShiftDetails (ParentRequestID, StartStatus, EndStatus,Status) values (" & RequestID & ", #" & requestDate + CoreStart & "#, #" & requestDate + shiftEnd & "#, 'DailyCore')"
'Debug.Print strSql
CurrentDb.Execute strSql
'Case 4 starts before core and ends after core
ElseIf ShiftStart < CoreStart And shiftEnd > CoreEnd Then
strSql = "Insert into TblShiftDetails (ParentRequestID, StartStatus, EndStatus,Status) values (" & RequestID & ", #" & requestDate + ShiftStart & "#, #" & requestDate + UnsocialEnd & "#, 'DailyUnsocial')"
'Debug.Print strSql
CurrentDb.Execute strSql
strSql = "Insert into TblShiftDetails (ParentRequestID, StartStatus, EndStatus,Status) values (" & RequestID & ", #" & requestDate + CoreStart & "#, #" & requestDate + CoreEnd & "#, 'DailyCore')"
'Debug.Print strSql
CurrentDb.Execute strSql
strSql = "Insert into TblShiftDetails (ParentRequestID, StartStatus, EndStatus,Status) values (" & RequestID & ", #" & requestDate + UnsocialStart & "#, #" & requestDate + shiftEnd & "#, 'DailyUnsocial')"
'Debug.Print strSql
CurrentDb.Execute strSql
End If
End If
End Sub
