Last reviewed on May 23, 2013   —  5 Comments

One big complaint about Outlook recurrence patterns is that there is not a pattern for Every xx weekday (Monday - Friday). You can create appointments for specific days of the week, but the every xx days pattern includes Saturday and Sunday.

The solution: a macro that copies the appointment details to a new appointment, using a function to check the day of the week for each date. When a date falls on Saturday or Sunday, it jumps ahead to Monday.

Note: currently this is not a true "every xx weekday" it's every xx days and when the date falls on a weekend or holiday, move it to the next weekday. For example, every other day is every Monday, Wednesday, and Friday using this code, not Monday, Wednesday, Friday, Tues, Thursday...

To use, you need to create the first appointment and save it, then run the macro. Enter the number of days between appointments and the number of appointments you need to create. The macro copies the fields from the first appointment and creates new appointments every xx days. Note: these are not recurring appointments, but individual appointments.

This macro does not skip holidays, only weekend dates. It will work with either opened appointments or selected appointments.

Create Every xx Weekday Series

To use, press Alt+F11 to open the VB Editor. Expand the folders on the left and right click to Insert a new module. Paste the following code into a module. Create a new appointment and save it, then run the macro.

Public Sub CreateSeriesofAppt()      
  Dim objAppt As Outlook.AppointmentItem
  Dim objAppt2 As Outlook.AppointmentItem
  Dim NumOfDays As Long
  Dim NumAppt As Long
  Dim nextAppt 'As Date
 Set objAppt = GetCurrentItem()
 If TypeName(objAppt) = "AppointmentItem" Then

NumOfDays = InputBox("How many days between appointments?")

NumAppt = InputBox("How many appointments in the series?")

nextAppt = NextWeekDaySeries(Format(objAppt.Start, "MM/dd/yyyy hh:mm"), NumOfDays + 1)
MsgBox nextAppt

For x = 1 To NumAppt
Set objAppt2 = Session.GetDefaultFolder(olFolderCalendar).Items.Add(olAppointmentItem)

      With objAppt
' I'm using a limited number of fields, you can 
' add others. 
        objAppt2.Subject = .Subject
        objAppt2.Location = .Location
        objAppt2.Body = .Body
        objAppt2.Start = nextAppt
        objAppt2.Duration = .Duration

      End With

      On Error Resume Next

nextAppt = NextWeekDaySeries(Format(nextAppt, "MM/dd/yyyy hh:mm"), NumOfDays + 1)
MsgBox nextAppt
Next x

End If
    Set objAppt = Nothing
    Set objAppt2 = Nothing

End Sub

Function NextWeekDaySeries(dateFrom As Date, _
    Optional daysAhead As Long = 1) As Date
  Dim currentDate As Date
  Dim nextDate As Date
  ' convert neg to pos
  If daysAhead < 0 Then
    daysAhead = Abs(daysAhead)
  End If
  ' determine next date
  currentDate = dateFrom
  nextDate = DateAdd("d", daysAhead, currentDate)

 ' Check for holidays entered as mm/dd/yyyy format

Dim arrHolidays  As Variant

' US Federal holidays + day after Thanksgiving & Christmas eve/day after. 
arrHolidays = Array("11/11/2012", "11/22/2012", "11/23/2012", "12/24/2012", "12/25/2012", "12/26/2012", "12/31/2012", _
"1/1/2013", "1/21/2013", "2/18/2013", "5/27/2013", "7/4/2013", "9/2/2013", "11/11/2013", "11/28/2013", "11/29/2013", "12/24/2013", "12/25/2013", "12/26/2013", "12/31/2013", _
"1/1/2014", "1/20/2014", "2/17/2014", "5/26/2014", "7/4/2014", "9/1/2014", "11/11/2014", "11/27/2014", "11/28/2014", "12/24/2014", "12/25/2014", "12/26/2014", "12/31/2014", _
"1/1/2015", "1/19/2015", "2/16/2015", "5/25/2015", "7/4/2015", "9/7/2015", "11/11/2015", "11/26/2015", "11/27/2015", "12/24/2015", "12/25/2015", "12/26/2015", "12/31/2015", "1/1/2016")

' Go through the array and look for a match, then do something
For i = LBound(arrHolidays) To UBound(arrHolidays)
If InStr(nextDate, arrHolidays(i)) Then nextDate = DateAdd("d", 1, nextDate)
  Select Case Weekday(nextDate, vbUseSystemDayOfWeek)
  Case vbSunday
    nextDate = DateAdd("d", 1, nextDate)
  Case vbSaturday
    nextDate = DateAdd("d", 2, nextDate)
  End Select

Next i

  NextWeekDaySeries = CDate(nextDate)
End Function

Function GetCurrentItem() As Object
    Dim objApp As Outlook.Application
    Set objApp = Application
    On Error Resume Next
    Select Case TypeName(objApp.ActiveWindow)
        Case "Explorer"
            Set GetCurrentItem = objApp.ActiveExplorer.Selection.Item(1)
        Case "Inspector"
            Set GetCurrentItem = objApp.ActiveInspector.CurrentItem
    End Select
    Set objApp = Nothing
End Function


    • Diane Poremsky says

      Holidays are a bit harder to work around since you need a list of dates. It's not impossible, it's just not as easy.

    • Diane Poremsky says

      You can add something like this to it (before or after the Select case block ) - but there are two problems. 1) if the nextdate is another date in the array, the macro doesn't go back and check it. If the holiday is Monday, the Sat & Sun routine doesn't skip it.

      When its after the Sat/Sun routine, it properly skips Monday holidays but if the recurrence pattern pushes it into the next weekend, that won't be checked.

      It can get unwieldy with a lot of dates. You also need to update the dates on a regular basis. Better, but more complicated, would be to get the dates of all Holiday categories within the expected span - sounds like a fun project when i have some free time. If more holidays are static, you could check just the month and day.

      Dim arrCat As Variant
      arrCat = Array("11/1/2012", "11/3/2012", "11/5/2012", "11/7/2012", "11/9/2012", "12/1/2012", "12/3/2012", "12/5/2012", "12/7/2012", "12/11/2012", "12/18/2012", "12/24/2012", "12/25/2012")

      ' Go through the array and look for a match, then do something
      For i = LBound(arrCat) To UBound(arrCat)
      If InStr(nextDate, arrCat(i)) Then nextDate = DateAdd("d", 1, nextDate)
      Next i

    • Diane Poremsky says

      Actually, in thinking about this, I wasn't thinking it through completely.

      The array code after the Sat/Sun check code should work - if a holiday is Fri, you can add sat & sun to the array as it loops to the next date in the array. (I forgot about the i, next i loop checking the next date in the array).

      arrCat = Array("11/1/2012", "11/2/2012", "11/3/2012", "11/7/2012", "11/29/2012", "11/30/2012", "12/3/2012", "12/9/2012", "12/11/2012", "12/18/2012", "12/24/2012", "12/25/2012", "12/26/2012", "12/31/2012", "1/1/2013")

  1. Steven says

    Nice! Thanks!
    Just what I was looking for, allthough I had a slightly different repeat... but you inspired me!

Leave a Reply

Please post long or more complicated questions at OutlookForums by

If the Post Comment button disappears, press your Tab key.