Option Compare Database
Function SetRecValues(Date1 As Date, Date2 As Date)
' ? SetRecValues(#12/13/2010#, #12/15/2010#)
DoCmd.SetWarnings False
Dim FirstDate As Date
Dim EndDate As Date
Dim RecordNo As Long
Dim ChangeType As String
Dim strSQ As String
strSQL = "INSERT INTO tblMonth (RecordNo, Date, Status) VALUES ("
' FirstDate = Me.Date1
' EndDate = Me.Date2
FirstDate = Date1
EndDate = Date2
RecordNo = 1
ChangeType = "A"
' ChangeType = cboTipoCambio.Value
Do While RecordNo <= 366
dtTempDate = FirstDate
Do While FirstDate <= EndDate
If ((Weekday(FirstDate <> vbSaturday)) And (Weekday(FirstDate <> vbSunday))) Then
' DoCmd.RunSQL strSQL & RecordNo & ",#" & Format FirstDate "mm/dd/yyyy") _
& "#," & ChangeType & ")"
End If
Debug.Print strSQL & RecordNo & ", #" & Format(FirstDate, "mm/dd/yyyy") _
& "#," & ChangeType & ")" _
& FirstDate, WeekdayName(Weekday(FirstDate))
FirstDate = DateAdd("d", 1, FirstDate)
Loop
FirstDate = DateAdd("d", 1, Date1)
RecordNo = RecordNo + 1
Loop
End Function
Public Function basWeeksInYear(intYear As Integer, WeekDayStart As Integer) As Integer
'Just determine the number of "Weeks" in the year
'? basWeeksInYear(2010, vbMonday) returns 52
Dim intWeeksInYear As Integer
basWeeksInYear = DateDiff("w", (DateSerial(intYear, 1, 1)), (DateSerial(intYear + 1, 1, 1)), WeekDayStart)
'Debug.Print intWeeksInYear
End Function
Public Function basMakeCalendar()
Dim dba As Database
Set dbs = CurrentDb
dbs.Execute "Create Table tblCalendar " _
& _
"(dt Date Primary Key, " _
& "IsWeekDay Integer, " _
& "IsHoliday Integer, " _
& "FY Integer, " _
& "Q Integer, " _
& "M Integer, " _
& "DW Integer, " _
& "MonthName Text (9), " _
& "W Integer, " _
& "UTC_Offset Integer Not Null);"
' 'Should have added Hopliday Name / Description to This?
dbs.Close
End Function
Public Function basPopulateCalendar()
'Populate the Calendar w/ Records
'? basPopulateCalendar _
Start @ 1/8/2011 10:20:15 PM _
End @ 1/8/2011 10:20:19 PM
Dim dbs As DAO.Database
Set dbs = CurrentDb
Dim strSQL As String
Dim strSQLValues As String
strSQL = "Insert Into tblCalendar (dt, UTC_Offset) Values "
Dim dt4Calendar As Date
Dim Add As Integer
intAdd = 0
Debug.Print "Start @ " & Now
While intAdd <= 10957
dt4Calendar = DateAdd("d", intAdd, #1/1/2011#)
strSQLValues = "(#" & dt4Calendar & "#, 5);"
dbs.Execute strSQL & strSQLValues
intAdd = intAdd + 1
Wend
Debug.Print "End @ " & Now
End Function
Public Function basCalcFields()
'? basCalcFields _
Start @ 1/9/2011 11:17:37 AM _
End @ 1/9/2011 11:17:38 AM
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset("tblCalendar", dbOpenDynaset)
Debug.Print "Start @ " & Now
With rst
While .EOF = False
.Edit
'Determine and SetWorkDay
If (Weekday(rst!dt) <> vbSunday And Weekday(!dt) <> vbSaturday) Then
!IsWeekDay = True
Else
!IsWeekDay = False
End If
'Initalize Holiday Status as False! Correct Later
!IsHoliday = False
'Get the date parts seperated
!Y = Year(!dt)
!M = Month(!dt)
!MonthName = MonthName(Month(!dt))
!D = Day(!dt)
!DayName = WeekdayName(Weekday(!dt))
!FY = Year(!dt)
'Set the Quarter
Select Case Month(!dt)
Case Is < 4
!Q = 1
Case Is < 7
!Q = 2
Case Is < 9
!Q = 3
Case Else
!Q = 4
End Select
'Numerical Day of the Week
!DW = Weekday(!dt)
'Week of the Year
!W = DatePart("WW", !dt)
'Wimp Holidays (only the Constants and Easy ones)
'Christmas
If (Month(!dt) = 12 And Day(!dt) = 25) Then
!IsHoliday = True
!HolidayName = "Christmas"
End If
'New Years Day
If (Month(!dt) = 1 And Day(!dt) = 1) Then
!IsHoliday = True
!HolidayName = "New Years"
End If
'Independence Day
If (Month(!dt) = 7 And Day(!dt) = 4) Then
!IsHoliday = True
!HolidayName = "Independence Day"
End If
.Update
.MoveNext
Wend
End With
Debug.Print "End @ " & Now
End Function
Public Function basMemorialday()
'Memorial Day. Last Monday in May
Dim dbs As DAO.Database
Set dbs = CurrentDb
Dim rst As DAO.Recordset
Set rst = dbs.OpenRecordset("qryLastDayInMay")
Dim rstUpdate As DAO.Recordset
Set rstUpdate = dbs.OpenRecordset("tblCalendar", dbOpenDynaset)
Dim dtMemDate As Date
Dim dtThanksgiving As Date
Dim strCriteria As String
With rst
While .EOF = False
dtMemDay = DateAdd("d", -Weekday(!dt), !dt)
strCriteria = "dt = " & "#" & dtMemDay & "#"
rstUpdate.FindFirst strCriteria
rstUpdate.Edit
rstUpdate!IsHoliday = True
rstUpdate!HolidayName = "Memorial Day"
rstUpdate.Update
.MoveNext
Wend
End With
End Function
Public Function basVetransDay()
'Vetrans Day
Dim dbs As DAO.Database
Set dbs = CurrentDb
Dim rst As DAO.Recordset
Set rst = dbs.OpenRecordset("qryVetransDay")
With rst
While .EOF = False
strCriteria = "dt = " & "#" & !dt & "#"
rstUpdate.FindFirst strCriteria
rstUpdate.Edit
rstUpdate!IsHoliday = True
rstUpdate!HolidayName = "Vetrans Day"
rstUpdate.Update
.MoveNext
Wend
End With
End Function
Public Function basThanksgivingDay()
'Thanksgining Day _
Fourth Thursday of November
Dim dbs As DAO.Database
Set dbs = CurrentDb
Dim rst As DAO.Recordset
Set rst = dbs.OpenRecordset("qryLastDayInMay")
Dim rstUpdate As DAO.Recordset
Set rstUpdate = dbs.OpenRecordset("tblCalendar", dbOpenDynaset)
Dim dtMemDate As Date
Dim dtThanksgiving As Date
Dim strCriteria As String
Set rst = dbs.OpenRecordset("qryThanksgiving")
With rst
While .EOF = False
strCriteria = "dt = " & "#" & !Thanksgiving & "#"
rstUpdate.FindFirst strCriteria
rstUpdate.Edit
rstUpdate!IsHoliday = True
rstUpdate!HolidayName = "Thanksgiving Day"
rstUpdate.Update
.MoveNext
Wend
End With
End Function
Public Function basWeekOfTheMonth()
'Populate WkOfMnth
Dim dbs As Database
Set dbs = CurrentDb
Dim rst As DAO.Recordset
Set rst = dbs.OpenRecordset("tblCalendar", dbOpenDynaset)
'Set the fist day of each month to be Firt Week of the month
Dim strSQL As String
strSQL = "UPDATE tblCalendar SET tblCalendar.WkOfMnth = 1 " _
& "WHERE (((tblCalendar.D)=1));"
DoCmd.SetWarnings Off
DoCmd.RunSQL strSQL
DoCmd.SetWarnings Off
Dim intIdx As Integer 'Simple Counter for the Week
Dim intWeek As Integer 'Our Local Week in the month (reset @ 1/mm)
Dim intMonth As Integer 'Current month in the year
Dim IntYr As Integer 'CurrentYear
rst.MoveFirst 'Assure we start @ the beginning
With rst 'Recordset to update (all Records)
intIdx = 1 'Init Counter for the (MAX) seven days per week
intMonth = !M 'Track for the current month
IntYr = !Y 'Track for the currnet Year
intWeek = 1
While .EOF = False 'Do all Records
'Change of week number criteria
If (!M <> intMonth) Or (!Y <> IntYr) Then
intWeek = 1
intIdx = 1
intMonth = !M
IntYr = !Y
End If
rst.Edit
!WkOfMnth = intWeek
rst.Update 'First record is initalized bu setup
intIdx = intIdx + 1 'Increment number of days in the week
If (intIdx > 7) Then 'Check for incrementing the Week
intIdx = 1
intWeek = intWeek + 1
End If
.MoveNext
Wend
End With
End Function
Public Function basContractsQuery()
Dim strSQL As String
strSQL = "SELECT c1.ContractID, c1.dt " _
& "FROM (SELECT " _
& "cons.ContractID , cal.dt " _
& "FROM dbo.Calendar cal " _
& "INNER Join " _
& "(SELECT ContractID, dtStart = MIN(dtStart), dtEnd = MAX(dtEnd) " _
& "FROM Contracts GROUP BY ContractID) cons " _
& "ON cal.dt BETWEEN cons.dtStart AND cons.dtEnd) c1 " _
& "LEFT OUTER JOIN " _
& "(SELECT cons2.ContractID , cal2.dt " _
& "FROM dbo.Calendar cal2 " _
& "INNER JOIN dbo.Contracts cons2 " _
& "ON cal2.dt BETWEEN cons2.dtStart AND cons2.dtEnd) c2 " _
& "ON c1.ContractID = c2.ContractID AND c1.dt = c2.dt " _
& "WHERE c2.dt Is Null"
DoCmd.RunSQL strSQL
End Function
Public Function basSubqueryW_Aggregate()
Dim strSQL As String
strSQL = "SELECT COUNT(*) - (SELECT COUNT(*)" _
& "FROM " _
& "(SELECT DISTINCT PositionNumber " _
& "FROM PositionPlacements " _
& "WHERE PositionType = 'Permanent') D) " _
& "FROM PositionPlacements " _
& "WHERE PositionType = 'Permanent'"
End Function
