Recurring appointments without counting weekends in outlook

[photon_ed]

Hello,

I wonder if anyone can help me with a small problem I am having with putting appointments on Outlook calendar.

I am trying to set up a appointment in microsoft outlook, recurring every 4 days but must nOt count weekend days. For example, if the appointment starts 17thApril2006 the appointment series will be, 21stApril2006, 27thApril2006, 2ndApril2006 and so on, it will be a bonus if it doesnt count bank holidays either.

I will be very grateful if someone can offer me a helping hand, thank you.

Yours,
Ed

[Ken Puls]

Hi Ed,

First off, welcome to VBAX! Funny you should ask about this, actually. I've been meaning to add Garbage day to my Outlook calendar so I don't forget. Our garbage days work on a five day work week rotation, plus a day for each statuatory holiday. I couldn't figure out a way to do it manually either, but I can help you with a little VBA to do it. (If there is a way to do this manually, I'd like someone to point that out though. )

So here's the deal with the code. You'll want to copy this into a standard module in Outlook, and update the following parts:
-The number of days you wish to increment your appointments goes with "lDaysToAdd". It's currently set to 5
-The last day you'd want an appointment to be created on goes in "dtMaxDay". Spell it out in full format. (ie "December 26, 2006")
-Update the Bank holiday string. Feel free to add as many as you want, but put them in order, and don't forget the "& sDlmtr & " part between each one.

Then save your project. If you've never run code from Outlook before, you may have to set your macro security warnings to a lower level, then exit and restart Outlook to allow the code to run.

Once you have the code in place, open the appointment you wish to copy, then run the code. Just as a note, it does not create them as official "Recurring Appointments", but rather as individual ones.

[vba]Option Explicit

Sub RecurAppointment()
'Macro created 04/22/2006 21:45 by Ken Puls
'Macro Purpose: Copy a currently existing appointment to a certain number
' of days out, ignoring weekends and bank holidays
'
'NOTE: Don't forget to open the instance of the appointment you wish to
' increment before running this code!

Dim iInspct As Inspector
Dim oActiveAppoint As AppointmentItem
Dim oNewAppoint As AppointmentItem
Dim lDaysToAdd As Long
Dim lTempdays As Long
Dim lAryCount As Long
Dim dtCurrentDay As Date
Dim dtMaxDay As Date
Dim aryHolidays() As String
Dim sHolidays As String
Const sDlmtr = "/"

'Enter your repeat cycle, stop date here
lDaysToAdd = 5
dtMaxDay = "May 26, 2006"

'Set your bank holidays here. Don't forget the '& sDlmtr &' between each date,
'make sure to spell out your dates in long hand format, and ensure that all dates
'are in ASCENDING DATE ORDER!

sHolidays = _
"January 2, 2006" & sDlmtr & _
"April 14, 2006" & sDlmtr & _
"April 17 2006" & sDlmtr & _
"May 22, 2006" & sDlmtr & _
"July 3, 2006" & sDlmtr & _
"August 7, 2006" & sDlmtr & _
"September 4, 2006" & sDlmtr & _
"October 9, 2006" & sDlmtr & _
"November 13, 2006" & sDlmtr & _
"December 25, 2006" & sDlmtr & _
"December 26, 2006"

'Send any errors to the error handler to clean up before exit
On Error GoTo ErrHandler

'Split the bank holiday string above into an array for inspection later
aryHolidays = Split(sHolidays, sDlmtr)

'Bind to the active inspector window, or exit routine if an inspector
'window is not active
Set iInspct = ActiveInspector
If iInspct Is Nothing Then GoTo ErrHandler

'Lock in to active appointment and record the start date
Set oActiveAppoint = iInspct.CurrentItem
dtCurrentDay = oActiveAppoint.Start

'Create new appointments
Do Until dtCurrentDay > dtMaxDay

'Find the next day...
For lTempdays = 1 To lDaysToAdd

'Advance other days
Select Case Format((dtCurrentDay), "ddd", vbSunday)
Case Is = "Fri"
'Skip Sat & Sun and go to Monday
dtCurrentDay = dtCurrentDay + 3
Case Is = "Sat"
'This should never happen since Friday will advance
'past weekend days
dtCurrentDay = dtCurrentDay + 2
Case Is = "Sun"
'This should never happen since Friday will advance
'past weekend days
dtCurrentDay = dtCurrentDay + 1
Case Else
'Add one day to move to next day
dtCurrentDay = dtCurrentDay + 1
End Select

'Deal with bank holidays, advancing the date a day if required
For lAryCount = LBound(aryHolidays) To UBound(aryHolidays)
If InStr(1, aryHolidays(lAryCount), _
Format((dtCurrentDay), "mmmm dd, yyyy", vbSunday)) _
Then dtCurrentDay = dtCurrentDay + 1
Next lAryCount
Next lTempdays

'Check that day is not higher than max range
'(Int used to remove fractional days from appointment)
If Int(dtCurrentDay) > Int(dtMaxDay) Then Exit Do

'Create the new appointment
Set oNewAppoint = CreateItem(olAppointmentItem)
With oNewAppoint
.AllDayEvent = oActiveAppoint.AllDayEvent
.Body = oActiveAppoint.Body
.Subject = oActiveAppoint.Subject
.Start = dtCurrentDay
.End = dtCurrentDay + (oActiveAppoint.End - oActiveAppoint.Start)
.Save
End With
Loop

'Clean up and exit
ErrHandler:
Set iInspct = Nothing
End Sub[/vba]
Before someone takes me to task on looping the bank holiday array, I'm game for a better way. I just couldn't visualize one when I was writing this up.

HTH,

EDIT: Code updated about 10 minutes after initial post as I identified a small error.

[photon_ed]

Dear Ken Puls,

ThAnk YoU very much for the prompt reply.

YOur codes works perfectly, THank YoU However, since i am an absolute beginner with vba, I am not too sure how to modify the code to make it more dynamic for using, the following are a couple of things I have in mind;

1. to delete (and edit if possible) the series of appointments which the vba code has created (much better the deleting and editing them one appointment at a time

2. for appointments recurring, say the 13th of each month but again not counting weekends and bank holidays

3. and a recurring appointment, not counting weekends and bank holidays, and will remind me 3 days in advance

I will be grateful if you can offer me suggestions and advices on the relevant modification, thank you very much for your help ken Puls

Yours,
Ed

[Ken Puls]

Hi Ed,

Sorry, but time has run out on me for coding tonight. I will try and get back to this tomorrow night. As for your requests, see if these are right:

1) You would like a a routine to delete all appointments that have the same subject line and body as the open appointment.

2) Shouldn't be too much of an issue.

3) The reminder needs to be 3 working days in advance, correct? So if the appointment is on a Tuesday, and the Monday was a holiday, the reminder should have presented itself on the Wednesday?

Cheers,

[photon_ed]

Thanks once again for your prompt reply. Regarding with your queries;

1. yes

2. Good To KnOw

3. Correct

I appreciate vErY mUcH fOr you hElp, Thank you.

Yours,
Ed