Date count to exclude weekends

[Colin Hayes]

Hi all

I us the routine below to allow 31 days before a workbook becomes
unavailable. Presently , it counts a straight 31 days against the
computer clock form the day the workbook was first used.

I'd like if possible to have this exclude weekends for the count , so
that that the routine only counts strictly working days (Monday -
Friday) in the 31 allowed.

Can someone advise?



Here's the routine :



Private Const C_NUM_DAYS_UNTIL_EXPIRATION = 31


Sub TB()
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' TB
' This procedure uses a defined name to store this workbook's
' expiration date. If the expiration date has passed, a
' MsgBox is displayed and this workbook is closed.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim ExpirationDate As String
Dim NameExists As Boolean

On Error Resume Next
ExpirationDate = Mid(ThisWorkbook.Names("ExpirationDate").Value, 2)
If Err.Number <> 0 Then
'''''''''''''''''''''''''''''''''''''''''''
' Name doesn't exist. Create it.
' If the defined name didn't exist,
' Save the workbook to establish the newly created name.
'''''''''''''''''''''''''''''''''''''''''''

If NameExists = False Then
ExpirationDate = CStr(DateSerial(Year(Now), _
Month(Now), Day(Date) + C_NUM_DAYS_UNTIL_EXPIRATION))
ThisWorkbook.Names.Add Name:="ExpirationDate", _
RefersToLocal:=Format(ExpirationDate, "short date"), _
Visible:=False 'False for final edition.
ThisWorkbook.Save 'saves on first open but not subsequent
openings
End If
Else
NameExists = True
End If


''''''''''''''''''''''''''''''''''''''''''''''''''''''
' If the today is past the expiration date, close the
' workbook. Give a countdown from 3 days to closure.

''''''''''''''''''''''''''''''''''''''''''''''''''''''

If CDate(Date) = (CDate(ExpirationDate) - 3) Then
MsgBox "Your trial period will expire in 3 days. ", vbExclamation
End If

If CDate(Date) = (CDate(ExpirationDate) - 2) Then
MsgBox "Your trial period will expire in 2 days ", vbExclamation
End If

If CDate(Date) = (CDate(ExpirationDate) - 1) Then
MsgBox "Your trial period will expire in 1 day", vbExclamation
End If

If CDate(Now) > CDate(ExpirationDate) Then
MsgBox "Your trial period has now expired", vbExclamation
ThisWorkbook.Close savechanges:=False
End If
End Sub



Grateful for any assistance.


Best Wishes