A function to return the next work day

I know there are plenty of routines already available to calculate work days, but this topic is not really about adding work days to a date or counting work days between two dates. Rather, it is an extension of the topic for making sure the result from a date calculation falls on a work day.

You are probably aware we can simply use the Weekday() function to make sure a date does not fall on a weekend. For example, the following routine will check if a given date falls on a weekend (Saturday or Sunday); and if so, we simply return the date for the following Monday.

Select Case WeekDay(InputDate)
     Case 1 'Input Date falls on a Sunday
          InputDate = DateAdd("d", 1, InputDate)

     Case 7 'Input Date falls on a Saturday
          InputDate = DateAdd("d", 2, InputDate)

End Select

I say this article is an extension of the above because I was recently asked to incorporate a check for Holidays as a non-work day. Much like the routines available for calculating work days, we need to use a table listing all the Holidays. Once we have this table, we can use the following routine to check if a date falls on a Holiday and simply return the following day.

If DCount("*", "tblHolidays", "HolidayDate=#" & Format(InputDate, "yyyy-mm-dd") & "#") > 0 Then
     InputDate = DateAdd("d", 1, InputDate)
End If

The problem with simply combining the above two subroutines is which one should we perform first? Let us say we decided to check for a Holiday first and then check for a weekend. If the new date falls on a weekend, the final result will return the date for the following Monday, and we're done. But what if the following Monday happens to be a Holiday?

Conversely, if we check for a weekend first and then followed by a check for a Holiday, we would solve the above problem. But what happens if the input date was on a Friday and it was also Holiday? Checking for a weekend first will fail and then checking for a Holiday will result on a weekend date.

So, as you can see, it is somewhat of a Catch-22 situation.

If you have followed my posts on UtterAccess, you might be familiar with how I like to use recursive functions to solve problems like this one. So, the below function is what I ended up using to continually check if a date falls on a Holiday or a weekend and return the next work day.

Public Function GetNextWorkDay(InputDate As Date) As Date
'3/16/2017
'http://thedbguy.blogspot.com
'if input date is on a weekend or a holiday, returns the next work day

On Error GoTo errHandler

'check for holiday
If DCount("*", "tblHolidays", "HolidayDate=#" & Format(InputDate, "yyyy-mm-dd") & "#") > 0 Then
    InputDate = GetNextWorkDay(DateAdd("d", 1, InputDate))
    
End If

'check for weekend
Select Case Weekday(InputDate)
    Case 1 'Input date falls on a Sunday
        InputDate = GetNextWorkDay(DateAdd("d", 1, InputDate))
        
    Case 7 'Input date falls on a Saturday
        InputDate = GetNextWorkDay(DateAdd("d", 2, InputDate))
    
End Select

GetNextWorkDay = InputDate

errExit:
    Exit Function
    
errHandler:
    MsgBox Err.Number & ". " & Err.Description
    Resume errExit
    
End Function

Hope you find it useful. Please let me know if you have any recommendations for improvement. Thank you for reading.

Retrieve Greenwich Mean Time (GMT)

I recently had a need to retrieve the current date and time from the Internet to prevent the user from merely changing the system clock to circumvent a security check I was performing.

Turns out, I don't even need a specific web service to provide the current date and time from a web server. Most web servers already include this information when it returns a page requested by a client. All we need to do is examine the response header.

One thing to note is the date and time provided by the web server is set to Greenwich Mean Time (GMT). If you need to know the "local" time, you will have to perform additional manipulation of the result using time zone information.

The following code simply retrieves the GMT from this blog site. If you were able to add any enhancements to this code, I would really love to hear about it. Hope you find it useful.

Public Function GetGMT() As Variant
'4/20/2016
'http://accessmvp.com/thedbguy
'Retrieves the Greenwich Mean Time (GMT) from theDBguy's blog server

On Error GoTo errHandler

Dim objHTTP As Object
Dim strURL As String
Dim strGMT As String

strURL = "http://thedbguy.blogspot.com"

Set objHTTP = CreateObject("Microsoft.XMLHTTP")

With objHTTP
    .Open "GET", strURL, False
    .Send
    strGMT = .getResponseHeader("Date")

End With

If strGMT <> "" Then
    strGMT = Mid(strGMT, 6, 20)
    If IsDate(strGMT) Then
        GetGMT = CDate(strGMT)
    Else
        GetGMT = Null
    End If
End If

errExit:
    Set objHTTP = Nothing
    Exit Function
    
errHandler:
    MsgBox Err.Number & ": " & Err.Description
    Resume errExit
    Resume
    
End Function