INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS
Come Join Us!
Are you a
Computer / IT professional?
Join Tek-Tips now!
- Talk With Other Members
- Be Notified Of Responses
To Your Posts
- Keyword Search
- One-Click Access To Your
Favorite Forums
- Automated Signatures
On Your Posts
- Best Of All, It's Free!
*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.
Partner With Us!
"Best Of Breed" Forums Add Stickiness To Your Site
(Download This Button Today!)
Feedback
"...I have answered some questions and have gotten answers for my questions. Anywhere you can do this on one page helps tremendously..."
Geography
Where in the world do Tek-Tips members come from?
|
Microsoft: Access Modules (VBA Coding) FAQ
|
How To
|
Build a Table of Holidays
Posted: 28 Jul 05 (Edited 8 Aug 05)
|
Any rigorous scheduling function requires that the application only schedule activities on a workday. The knowledgebase and many other applications require that a table be developed that contains all the holidays for a given period. My application required scheduling events many years in advance so I either needed to manually build the holidays table or build one programmatically. the following code will load a table called tblHolidays with the date, name, and day of a given set of holidays for a year. The supplementary functions allow a user to drive the main function to build holidays for an integer number of years starting with this year and also get the day of the holiday during the loading process.
There are three main types of searches to determine a holiday. 1) On a specific date or the Monday following,
2) On the x occurrence of a day in a given month, 3) on the last occurence of a day in a given month. You can therefore use the template snippets within the function BuildHolidayList to create the code for other holidays. There are sites on the internet that will provide the rules for determining various holidays.
My internet search for this capability failed so I developed this one. It would be relatively easy to add holidays or to tailor the function to allow a return of true/false if a given day was a holiday.
You would need to modify the error handling to conform to whatever functionality your applications use.
TSQL Script to create the table:
CREATE TABLE tblHolidays
(
ID int IDENTITY(1, 1),
HolidayDate datetime,
Name varchar(50),
Weekday varchar(9)
)
Public Type HolidayData
dtDate As Date
strName As String
strWeekday As String
End Type
Dim vHolidayInfo(8) As HolidayData
Public Function BuildHolidayList(BuildYear As Long)
Dim lngDay As Long
Dim intWeekday As Integer
Dim intMondayCount As Integer
Dim intThursdayCount As Integer
Dim dtDate As Date
Dim strSQL As String
On Error GoTo HandleErr
' Get New Year's Day Holiday
' 1/1 or following Monday
dtDate = CDate("1/1/" & CStr(BuildYear))
With vHolidayInfo(0)
.dtDate = GetMondayFollowing(dtDate)
.strName = "New Year's Day"
.strWeekday = GetWeekday(.dtDate)
End With
' Get MLK Holiday
' Third Monday in January
dtDate = CDate("1/1/" & CStr(BuildYear))
For lngDay = 0 To 30
intWeekday = Weekday(dtDate + lngDay)
If intWeekday = vbMonday Then
With vHolidayInfo(1)
.dtDate = dtDate + lngDay + 14
.strName = "Martin Luther King's Birthday"
.strWeekday = GetWeekday(.dtDate)
End With
Exit For
End If
Next lngDay
' Third Monday in February
dtDate = CDate("2/1/" & CStr(BuildYear))
For lngDay = 0 To 27
intWeekday = Weekday(dtDate + lngDay)
If intWeekday = vbMonday Then
With vHolidayInfo(2)
.dtDate = dtDate + lngDay + 14
.strName = "President's Day"
.strWeekday = GetWeekday(.dtDate)
End With
Exit For
End If
Next lngDay
' Last Monday in May
dtDate = CDate("5/1/" & CStr(BuildYear))
For lngDay = 0 To 31
intWeekday = Weekday(dtDate + lngDay)
If intWeekday = vbMonday Then
With vHolidayInfo(3)
.dtDate = dtDate + lngDay
.strName = "Memorial Day"
.strWeekday = GetWeekday(.dtDate)
End With
End If
Next lngDay
dtDate = CDate("7/4/" & CStr(BuildYear))
With vHolidayInfo(4)
.dtDate = GetMondayFollowing(dtDate)
.strName = "Independence Day"
.strWeekday = GetWeekday(.dtDate)
End With
' First Monday in September
dtDate = CDate("9/1/" & CStr(BuildYear))
For lngDay = 0 To 29
intWeekday = Weekday(dtDate + lngDay)
If intWeekday = vbMonday Then
With vHolidayInfo(5)
.dtDate = dtDate + lngDay
.strName = "Labor Day"
.strWeekday = GetWeekday(.dtDate)
End With
Exit For
End If
Next lngDay
' First Fourth Thursday in November
dtDate = CDate("11/1/" & CStr(BuildYear))
intThursdayCount = 0
For lngDay = 0 To 31
intWeekday = Weekday(dtDate + lngDay)
If intWeekday = vbThursday Then
intThursdayCount = intThursdayCount + 1
If intThursdayCount = 4 Then
With vHolidayInfo(6)
.dtDate = dtDate + lngDay
.strName = "Thanksgiving Day"
.strWeekday = GetWeekday(.dtDate)
End With
With vHolidayInfo(7)
.dtDate = dtDate + lngDay + 1
.strName = "Day-After Thanksgiving"
.strWeekday = GetWeekday(.dtDate)
End With
Exit For
End If
End If
Next lngDay
dtDate = CDate("12/25/" & CStr(BuildYear))
With vHolidayInfo(8)
.dtDate = GetMondayFollowing(dtDate)
.strName = "Christmas Day"
.strWeekday = GetWeekday(.dtDate)
End With
strSQL = "DELETE FROM tblHolidays WHERE YEAR(HolidayDate) IN (" & CLng(BuildYear) & ")"
DoCmd.RunSQL strSQL
For lngDay = 0 To 7
strSQL = "INSERT INTO tblHolidays (HolidayDate, Name, Weekday) " _
& "VALUES (CAST('" & CStr(vHolidayInfo(lngDay).dtDate) _
& "' As datetime), '" & vHolidayInfo(lngDay).strName & "', '" _
& vHolidayInfo(lngDay).strWeekday & "')"
DoCmd.RunSQL strSQL
Next lngDay
Exit_Proc:
Exit Function
HandleErr:
Select Case Err.Number
Case Else
Call ErrorLog("basSchedule_BuildHolidayList", Err)
End Select
Resume Exit_Proc
Resume
End Function
Public Function GetWeekday(dtDate As Date) As String
Dim strWeekday As String
Dim intWeekday As Integer
intWeekday = Weekday(dtDate)
On Error GoTo HandleErr
Select Case intWeekday
Case vbMonday
strWeekday = "Monday"
Case vbTuesday
strWeekday = "Tuesday"
Case vbWednesday
strWeekday = "Wednesday"
Case vbThursday
strWeekday = "Thursday"
Case vbFriday
strWeekday = "Friday"
Case vbSaturday
strWeekday = "Saturday"
Case vbSunday
strWeekday = "Sunday"
Case Else
strWeekday = "Unknown"
End Select
GetWeekday = strWeekday
Exit_Proc:
Exit Function
HandleErr:
Select Case Err.Number
Case Else
Call ErrorLog("basSchedule_GetWeekday", Err)
End Select
Resume Exit_Proc
Resume
End Function
Public Function BuildHolidayLists(lngYears As Long)
Dim lngYear As Long
lngYear = Year(Date)
For lngYears = 0 To lngYears - 1
Call BuildHolidayList(lngYear + lngYears)
Next lngYears
End Function
Public Function GetMondayFollowing(dtDate As Date) As Date
On Error GoTo HandleErr
'vbSaturday = 7
'vbSunday = 0
Dim intDayOfWeek
intDayOfWeek = Weekday(dtDate)
Select Case intDayOfWeek
Case vbMonday To vbFriday
GetMondayFollowing = dtDate
Case vbSaturday
GetMondayFollowing = dtDate + 2
Case vbSunday
GetMondayFollowing = dtDate + 1
End Select
Exit_Proc:
Exit Function
HandleErr:
Select Case Err.Number
Case Else
Call ErrorLog("basSchedule_GetMondayFollowing", Err)
End Select
Resume Exit_Proc
Resume
End Function |
Back to Microsoft: Access Modules (VBA Coding) FAQ Index
Back to Microsoft: Access Modules (VBA Coding) Forum
|
|
 |
|
Join Tek-Tips® Today!
Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.
Here's Why Members Love Tek-Tips Forums:
Talk To Other Members- Notification Of Responses To Questions
- Favorite Forums One Click Access
- Keyword Search Of All Posts, And More...
Register now while it's still free!
Already a member? Close this window and log in.
Join Us Close
