|
|
|
|
|
|
|
|
Access
|
Force Dates to Fall on Friday or Monday
|
|
|
Ease of Use
|
Intermediate
|
|
Version tested with
|
2000, 2002
|
|
Submitted by:
|
jamescol
|
|
Description:
|
Ensure that a given date falls on a weekday, instead of over the weekend. This function accepts a date as a parameter, and determines whether or not it falls on a weekend. It allows the user to determine if they want the next weekday, the previous weekday, or the nearest weekday returned.
|
|
Discussion:
|
Often a program needs to ensure that a calculated date falls on a business day and not a weekend. For instance, automating a series of reminders to contact a customer, review a recurring report, etc.
Once your program calculates a date, this function moves it forward or backward and returns a date that is not on a weekend.
|
|
Code:
|
instructions for use
|
Option Compare Database
Option Explicit
Public Enum vbDirection
vbForward = 1
vbBackward = 2
vbNearest = 3
End Enum
Public Function AdjustWeekendDate(dtDate As Date, intDirection As vbDirection) As Date
On Error Goto Err_AdjustWeekendDate
'In many cases it makes sense to declare these variables as CONST and make them Public
'since you are likely using VB date functions elsewhere in your code if you need the
'AdjustWeekendDate function.
'International users can substitute vbSaturday for local weekend/non-working days
If Weekday(dtDate) = vbSaturday Then
' Determine next move based on specified direction
Select Case intDirection
Case vbForward
'If the renewal date is going forward from a Saturday then
' move it foward two days to Monday
AdjustWeekendDate = DateAdd("d", 2, dtDate)
Case vbBackward, vbNearest
'If the renewal date is on a Saturday, move it back one day to Friday
AdjustWeekendDate = DateAdd("d", -1, dtDate)
End Select
'International users can substitute vbSunday for local weekend/non-working days
ElseIf Weekday(dtDate) = vbSunday Then
' Determine next move based on specified direction
Select Case intDirection
Case vbForward, vbNearest
'If the renewal date is on a Sunday, move it forward one day to Monday
AdjustWeekendDate = DateAdd("d", 1, dtDate)
Case vbBackward
'If the renewal date is going backwards from a Sunday then
' move it back two days to Friday
AdjustWeekendDate = DateAdd("d", -2, dtDate)
End Select
Else
'The date is not on a weekend, return dtReminderDate
AdjustWeekendDate = dtDate
End If
' Error Handler
Exit_AdjustWeekendDate:
Exit Function
Err_AdjustWeekendDate:
MsgBox Err.Description, vbExclamation, "Error #" & Err.Number
Resume Exit_AdjustWeekendDate
End Function
' End of Code
|
|
How to use:
|
- To get the next weekday date:
-
- Dim dtDate as Date
- TextBox = AdjustWeekendDate(dtDate, vbForward)
-
-
- To get the previous weekday date:
-
- Dim dtDate as Date
- TextBox = AdjustWeekendDate(dtDate, vbBackward)
-
-
- To get the nearest weekday date:
-
- Dim dtDate as Date
- TextBox = AdjustWeekendDate(dtDate, vbNearest)
|
|
Test the code:
|
- First, open a standalone module and copy and paste the code above into it. Save the module.
-
- Next, open a query and switch from Design View to SQL View. Copy and paste the following SQL statement:
-
- SELECT AdjustWeekendDate(#6/19/2004#,1) AS SaturdayForward, AdjustWeekendDate(#6/19/2004#,2) AS SaturdayBackward, AdjustWeekendDate(#6/19/2004#,3) AS SaturdayNearest, AdjustWeekendDate(#6/20/2004#,1) AS SundayForward, AdjustWeekendDate(#6/20/2004#,2) AS SundayBackward, AdjustWeekendDate(#6/20/2004#,3) AS SundayNearest;
-
- Save the query and then open it. You should see that the requested date is retrieved by the AdjustWeekendDate() function.
|
|
Sample File:
|
dbAdjustWeekendDate.zip 43.65KB
|
|
Approved by mdmackillop
|
|
This entry has been viewed 102 times.
|
|
|