Ok. Here are the functions. They are divided up to offer more flexibility and work(hopefully) internationally.
They should allow the user to determine which day-of-the-week is the first day - the first day being the first Work day. There could be more flexibilty added (the actual function which I use allows the user to determine exactly which days are work days - some countries a Weds and Sun. may be the weekend days, or a Sat. is always a legal workday). So, hopefully if all works right, the user doesn't have to depend on Moday as being the first work day, and Sunday a day off...
=========================================================
MichaelRed: I only mentioned the possibility of the holiday function, even though the questioner didn't ask for it. The holiday function, as you should have seen above, calculates and returns the number of holidays that fall with-in the time period, based on whether the user wants included in the count the holidays which fall on a weekend or not:
bWeekDaysOnly:=True
=========================================================
The day of the year today is 298, not 297
=========================================================
Public Function CountWeekDays_pFlng(ByRef dtStartDate As Date, ByRef dtEndDate As Date, _
Optional ByVal bCalcHolidays As Boolean = True, _
Optional ByVal lFirstDayOfWeek As VbDayOfWeek = vbMonday) As Long
Dim lWeeks As Long
Dim lWeekDays As Long
Dim dtCurrentDate As Date
Dim iSgn As Integer
iSgn = Sgn(dtEndDate - dtStartDate)
If iSgn = 0 Then
Exit Function 'Dates are equal
ElseIf iSgn = -1 Then
'Flip the dates
dtCurrentDate = dtStartDate
dtStartDate = dtEndDate
dtEndDate = dtCurrentDate
End If
lWeeks = DateDiff("w", dtStartDate, dtEndDate)
lWeekDays = lWeeks * 5
dtCurrentDate = dtStartDate + (lWeeks * 7)
If Weekday(dtCurrentDate, lFirstDayOfWeek) < vbSaturday Then dtCurrentDate = dtCurrentDate + 1
Do Until dtCurrentDate > dtEndDate
lWeekDays = lWeekDays + Abs(Weekday(dtCurrentDate, lFirstDayOfWeek) < 6)
dtCurrentDate = dtCurrentDate + 1
Loop
If bCalcHolidays Then lWeekDays = lWeekDays - CountHolidaysInRange_pFlng(dtStartDate, dtEndDate, bWeekDaysOnly:=True, lFirstDayOfWeek:=lFirstDayOfWeek)
CountWeekDays_pFlng = lWeekDays * iSgn
End Function
============================================================
Private Function CountHolidaysInRange_pFlng(Optional ByVal sStartDate As String, Optional ByVal sEndDate As String, _
Optional ByVal bWeekDaysOnly As Boolean = True, _
Optional ByVal lFirstDayOfWeek As VbDayOfWeek = vbMonday) As Long
Dim sList As Variant
Dim dtItem As Variant
Dim sCurrentDate As String
Dim lHolidays As Long
If sEndDate < sStartDate Then
'Flip the dates
sCurrentDate = sStartDate
sStartDate = sEndDate
sEndDate = sCurrentDate
End If
'Get liat of Holidays between the date range
sList = GetHolidaysInRange_pFlng(sStartDate, sEndDate)
If Not IsEmpty(sList) Then
If bWeekDaysOnly Then
'Check if the date is a weekday or not
For Each dtItem In sList
If Weekday(dtItem, lFirstDayOfWeek) < vbSaturday Then lHolidays = lHolidays + 1
Next dtItem
Else
lHolidays = UBound(sList) - LBound(sList)
End If
End If
CountHolidaysInRange_pFlng = lHolidays
End Function
============================================================
'The Holiday Data: Could be just any array of dates returned
Private Function GetHolidaysInRange_pFlng(Optional ByVal sStartDate As String, Optional ByVal sEndDate As String) As Variant
Const gcSQLDATE = "\#mm\/dd\/yyyy\#"
Const gcCOMMA$ = ","
Dim conPubs As New ADODB.Connection
Dim rsData As New ADODB.Recordset
Dim sqlString As String
Dim sGetString As String
On Error GoTo ErrHandler
conPubs.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=e:\test\MyData.Mdb;Jet OLEDB:Engine Type=5"
sqlString = "SELECT datum FROM Holidays"
If IsDate(sStartDate) And IsDate(sEndDate) Then sqlString = sqlString _
& " WHERE datum BETWEEN " & Format$(sStartDate, gcSQLDATE) & " AND " & Format$(sEndDate, gcSQLDATE)
With rsData
.CursorLocation = adUseServer
.Open sqlString, conPubs, adOpenKeyset
If Not .EOF Then
'Use the GetString to retrieve data comma delimited
sGetString = rsData.GetString(RowDelimeter:=gcCOMMA)
'Remove last comma
If Right$(sGetString, 1) = gcCOMMA Then sGetString = Left$(sGetString, Len(sGetString) - 1)
'Use Split function to change string to an array
GetHolidaysInRange_pFlng = Split(sGetString, gcCOMMA)
End If
.Close
End With
conPubs.Close
ExitProceedure:
Set conPubs = Nothing
Set rsData = Nothing
Exit Function
ErrHandler:
'Place your error handler here
End Function
[/b][/i][/u]*******************************************************
General remarks:
If this post contains any suggestions for the use or distribution of code, components or files of any sort, it is still your responsibility to assure that you have the proper license and distribution rights to do so!