|
interweb -> RE: Calculate date with working days (2/3/2006 19:21:07)
|
Finally worked it all out. [:)] Thought I might share what I ended up with. This calculates Estimated UPS Delivery date and takes into account UPS holidays and weekends. Its purpose is to show delivery date for Next Day, Second Day, and Saturday delivery (when appropriate) as well as taking into account time of day (merchant ships same day for non-holiday weekday orders before 3 PM, otherwise it ships next business day). The way I'm using it, the result is inserted into an existing option list of shipping options. Credit to those who went before me, however this is basically a rewrite to accommodate the features I needed. Note that UPS Holidays are stored in a database table named "upsHolidays" containing one column named "holidayDate" datatype: datetime, no nulls, primary key. They are stored in short format i.e., mm/dd/yyyy.
<%
''' code is designed to be in an include file
Dim CurrentDate, CurrentTime, showSaturday
Dim StartDate, tempStartDate, tempDeliveryDate, tempSaturdayDate, DayCounter
Dim upsHolidaySQL, upsHolidayConn, upsHolidayRS, HolidayArray, HolidayItem
HolidayArray = upsHolidays
CurrentDate = Date()
CurrentTime = Time()
StartDate = getStartDate(CurrentDate,CurrentTime)
showSaturday = showSaturdayShipOption(CurrentDate,CurrentTime)
Function upsHolidays
upsHolidaySQL = "SELECT holidayDate FROM upsHolidays Order by holidayDate"
Set upsHolidayConn = Server.CreateObject("ADODB.Connection")
upsHolidayConn.open Session("DSN_Name")
Set upsHolidayRS = upsHolidayConn.Execute(upsHolidaySQL)
upsHolidays = upsHolidayRS.GetRows
upsHolidayRS.Close
Set upsHolidayRS = Nothing
upsHolidayConn.Close
Set upsHolidayConn = Nothing
End Function
Function getStartDate(CurrentDate,CurrentTime)
tempStartDate = CurrentDate
If WeekDay(tempStartDate) = 7 Then
tempStartDate = DateAdd("D", 2, tempStartDate)
ElseIf WeekDay(tempStartDate) = 1 Then
tempStartDate = DateAdd("D", 1, tempStartDate)
Else
If isHoliday(tempStartDate,HolidayArray) Then
Do Until isHoliday(tempStartDate,HolidayArray) = False
tempStartDate = DateAdd("D", 1, tempStartDate)
Loop
Else
If FormatDateTime(CurrentTime,4) > FormatDateTime("2:59:59 PM",4) Then
tempStartDate = DateAdd("D", 1, tempStartDate)
Do Until isHoliday(tempStartDate,HolidayArray) = False AND NOT (WeekDay(tempStartDate) = 7 OR WeekDay(tempStartDate) = 1)
tempStartDate = DateAdd("D", 1, tempStartDate)
Loop
End if
End if
End if
If isHoliday(tempStartDate,HolidayArray) Then
Do Until isHoliday(tempStartDate,HolidayArray) = False AND NOT (WeekDay(tempStartDate) = 7 OR WeekDay(tempStartDate) = 1)
tempStartDate = DateAdd("D", 1, tempStartDate)
Loop
End if
getStartDate = tempStartDate
End Function
Function getDeliveryByDate(StartDate, numberOfDays)
tempDeliveryDate = DateAdd("D", 1, StartDate)
DayCounter = 0
Do Until DayCounter = numberOfDays
If isHoliday(tempDeliveryDate,HolidayArray) = False AND NOT (WeekDay(tempDeliveryDate) = 7 OR WeekDay(tempDeliveryDate) = 1) Then
DayCounter = DayCounter + 1
End if
If DayCounter = numberOfDays Then
getDeliveryByDate = " Delivery by " & WeekdayName(WeekDay(tempDeliveryDate)) & " " & tempDeliveryDate
Exit Do
Else
tempDeliveryDate = DateAdd("D", 1, tempDeliveryDate)
End if
Loop
End Function
Function isHoliday(aDate,HolidayArray)
isHoliday = False
For HolidayItem = LBound(HolidayArray,2) To UBound(HolidayArray,2)
If CDate(HolidayArray(0,HolidayItem)) = CDate(aDate) Then
isHoliday = True
Exit For
End If
Next
End Function
Function showSaturdayShipOption(CurrentDate,CurrentTime)
If WeekDay(CurrentDate) = 5 OR WeekDay(CurrentDate) = 6 Then
Select Case WeekDay(CurrentDate)
Case "5" ' Thursday
If FormatDateTime(CurrentTime,4) > FormatDateTime("2:59:59 PM",4) Then
showSaturdayShipOption = getSaturdayDate(CurrentDate)
Else
showSaturdayShipOption = False
End if
Case "6" ' Friday
If isHoliday(CurrentDate,HolidayArray) = True Then
showSaturdayShipOption = False
Else
If FormatDateTime(CurrentTime,4) < FormatDateTime("3:00:01 PM",4) Then
showSaturdayShipOption = getSaturdayDate(CurrentDate)
Else
showSaturdayShipOption = False
End if
End if
End Select
Else
showSaturdayShipOption = False
End if
End Function
Function getSaturdayDate(CurrentDate)
tempSaturdayDate = CurrentDate
Do Until WeekDay(tempSaturdayDate) = 7
tempSaturdayDate = DateAdd("D", 1, tempSaturdayDate)
If isHoliday(tempSaturdayDate,HolidayArray) = True Then
getSaturdayDate = False
Exit Do
End if
Loop
getSaturdayDate = "Delivery by " & WeekdayName(WeekDay(tempSaturdayDate)) & " " & tempSaturdayDate
End Function
%>
Function is then called like this:
<%=getDeliveryByDate(StartDate,1)%>
where the numeral is the number of days e.g., next day = 1 & 2nd day = 2.
|
|
|
|
