Dim strAllDayOOF As String
Public WithEvents OlItems As Outlook.Items
 
Public Sub Initialize_handler()
   Set OlItems = Application.GetNamespace("MAPI"). _
        GetDefaultFolder(olFolderInbox).Items
End Sub
 
Private Sub OlItems_ItemChange(ByVal Item As Object)
 
If Item.IsMarkedAsTask = True Then
If Item.TaskDueDate = Date + 1 Then
 startDate = NextWeekDaySeries(Date, 1)
 
 With Item
    .MarkAsTask olMarkNoDate
    .TaskStartDate = startDate
    .TaskDueDate = startDate
    .ReminderSet = True
    .ReminderTime = startDate
    .Save
 End With
 
End If
 
End If
 
End Sub
 
Private Function NextWeekDaySeries(dateFrom As Date, _
    Optional daysAhead As Long = 1) As Date
  Dim currentDate As Date
  Dim startDate As Date
GetHolidaysOOF
  ' convert neg to pos
  If daysAhead < 0 Then
    daysAhead = Abs(daysAhead)
  End If
 
  ' determine next date
  currentDate = dateFrom
  startDate = DateAdd("d", daysAhead, currentDate)
 
Dim arrHolidays  As Variant
' To be included, holidays need to be marked with a busy state, not Free
arrHolidays = Split(strAllDayOOF, ",")
 
' Test the date for multiple days off, covers Monday holidays
Dim sameDate As Date
sameDate = Date
Do Until sameDate = startDate + 1
' Go through the array and look for a match, then do something
For i = LBound(arrHolidays) To UBound(arrHolidays)
Debug.Print arrHolidays(i)
If InStr(startDate, arrHolidays(i)) Then startDate = DateAdd("d", 1, startDate)
 
  Select Case Weekday(startDate, vbUseSystemDayOfWeek)
  Case vbSunday
    startDate = DateAdd("d", 1, startDate)
  Case vbSaturday
    startDate = DateAdd("d", 2, startDate)
  End Select
 
Next i
sameDate = sameDate + 1
Debug.Print sameDate, startDate
 
Loop
  NextWeekDaySeries = CDate(startDate)
 
End Function
 
Sub GetHolidaysOOF()
' Check for all day events on calendar
'  marked busy/off/tentative
'  skips recurring events
' To be included, holidays need to be marked with a busy state, not Free
 
   Dim CalItems As Outlook.Items
   Dim ResItems As Outlook.Items
   Dim sFilter As String
   Dim iNumRestricted As Integer
   Dim itm As Object
 
   ' Use the selected calendar folder
   Set CalFolder = Session.GetDefaultFolder(olFolderCalendar)
   Set CalItems = CalFolder.Items
 
   ' Sort all of the appointments based on the start time
   CalItems.Sort "[Start]"
   CalItems.IncludeRecurrences = False
 
   ' Set dates
   sFilter = "[Start] >= '" & Date & "' And [AllDayEvent] = 'True' And [BusyStatus] <> '0' AND [IsRecurring] = 'False'"
 
   Set ResItems = CalItems.Restrict(sFilter)
 
   iNumRestricted = 0
 
   'Loop through the items in the collection.
   For Each itm In ResItems
      iNumRestricted = iNumRestricted + 1
      Debug.Print Format(itm.Start, "m/d/yyyy")
 ' Create list of dates
  strAllDayOOF = strAllDayOOF & Format(itm.Start, "m/d/yyyy") & ","
   Next
 
 ' clean the string for the array
strAllDayOOF = Left(strAllDayOOF, Len(strAllDayOOF) - 1)
 
   Set ResItems = Nothing
   Set CalItems = Nothing
   Set CalFolder = Nothing
End Sub