How to get Recurring Appointment dates with VBA?

  • Thread starter Thread starter deko
  • Start date Start date
D

deko

I need to loop through all future Outlook appointment items and populate a
table with the date and subject of each appointment. The problem is with
recurring apointments - how do I get the recurring dates? If the
appointment is NOT recurring, this works:

Dim ola As Outlook.AppointmentItem
For Each ola In olns.GetDefaultFolder(olFolderCalendar).Items
If ola.Start > Date Then
myDate = ola.Start
mySubject = ola.Subject
End If

But the above code will not return recurring appointments.

I've tried this, but no luck:

If ola.IsRecurring Then
Dim varItem As Variant
Dim apptRcrPat As Outlook.RecurrencePattern
Set apptRcrPat = ola.GetRecurrencePattern
For Each varItem In apptRcrPat
Debug.Print varItem
Next
End If

Suggestions welcome. Thanks in advance.
 
I think I may have found the answer:

Dim ola As Outlook.AppointmentItem
Dim rcrAppts As Outlook.Items
Dim rcrApptItem As Outlook.AppointmentItem

If ola.IsRecurring Then
Set rcrAppts = olns.GetDefaultFolder(olFolderCalendar).Items
rcrAppts.Sort "[Start]"
rcrAppts.IncludeRecurrences = True
Set rcrApptItem = rcrAppts.Find("[Start] >= """ & Date & """
and [Start] <= """ & Date + 365 & """")
While TypeName(rcrApptItem) <> "Nothing"
Debug.Print rcrApptItem.Start & " " & rcrApptItem.Subject
Set rcrApptItem = rcrAppts.FindNext
Wend
End If

But this raises a question - Is it better to always use Find and FindNext to
get appointment info?

For example, I'm currently using this to get non-recurring appointment info:

For Each ola In olns.GetDefaultFolder(olFolderCalendar).Items
If someCondition Then
do stuff
End If
Next

Would I be better off using Find and FindNext in a While loop - or should I
stick with the For Each Loop?
 
IncludeRecurrences is indeed the key. You can use either Find or Restrict,
depending on your goal. If you use Restrict, then you can use a For Each
loop on the results.

You might find the information at http://www.outlookcode.com/d/finddate.htm
useful. It suggests some refinements.
 
You might find the information at
http://www.outlookcode.com/d/finddate.htm
useful. It suggests some refinements.
Click to expand...

I wish I had known about Find and Restrict earlier :)

The MS documentation says: "The Restrict method is significantly faster if
there is a large number of items in the collection, especially if only a few
items in a large collection are expected to be found."
(http://msdn.microsoft.com/library/default.asp?url=/library/en-us/vbaol11/ht
ml/olmthRestrict.asp)

But I'm kind of lost trying to put Restrict into action along with
IncludeRecurrences.

What I'm trying to do is integrate the OL calendar with an Access Contact
Management Database (mdb). The idea is to allow users to set, get, update
and delete appointments from within Access. This provides automatic
association of appointments with contacts in the mdb.

One of the challenges in doing this is finding a way to differentiate
"Access" appointments from "Outlook" appointments - so users can still use
the OL calendar as normal but can easily recognize appointments that "belong
to the database", so to speak. So what I did was use the Location field to
store the Entity_ID of the database record. I could have used a different
field, but Location was clearly visible on the default Outlook appointment
form (I wanted to avoid custom forms); the downside, obviously, is that you
cannot use the Location field.

In any case, I have code that adds appointments, and also code that syncs up
the database with outlook. Here's the (abbreviated) code that *gets* the
appointments when the sync code is run:

Dim ola As Outlook.AppointmentItem

For Each ola In olns.GetDefaultFolder(olFolderCalendar).Items
If ola.Start >= (myStartDate) And ola.Start <= (myEndDate) Then
If Not IsNumeric(ola.Location) Or IsNull(ola.Location)
Then
varAloc = 0
'sets Entity_ID to 0 so the database will know this is
an "Outlook" appointment
Else
varAloc = ola.Location 'this is assumed to be an
Entity_ID
End If
With rstAppt
.AddNew
!Entity_ID = varAloc
If Format(TimeValue(CDate(ola.Start)), "Medium
Time") <> "12:00 AM" _
Then !ApptTime =
Format(TimeValue(CDate(ola.Start)), "Medium Time")
!ApptDate = Format(DateValue(CDate(ola.Start)),
"Short Date")
!ApptDay = Format(DateValue(CDate(ola.Start)),
"ddd")
!Subject = ola.Subject
.Update
End With
End If
Next

The problem is: 1) recurring appointments are missed, and 2) it's slow -
since it has to loop through all appointment items in the OL calendar.

Now let's try it with the Restrict Method:

Dim ola As Outlook.AppointmentItem
Dim olaRcr As Outlook.AppointmentItem
Dim oli As Outlook.Items
Dim oliRcr as Outlook.Items
Dim oliRct As Outlook.Items
Dim rcrAppt As Outlook.Items
Dim objItem As Object

Set olir = olns.GetDefaultFolder(olFolderCalendar).Items
Set oli = oliRct.Restrict("[Location] Like '#'") '?????
'can I use more than one Restrict criteria?
oli.IncludeRecurrences.True
For Each objItem in oli
If objItem.IsRecurring Then
Set oliRcr = olns.GetDefaultFolder(olFolderCalendar).Items
Set oliRcr.IncludeRecurrences = True
Set olaRcr = oliRcr.Find("[Start] >= " & Chr(34) & _
myStartDate & " and [Start] <= " & Chr(34) & myEndDate & Chr(34))
While TypeName(olaRcr) <> "Nothing" [add to Access
recordset here]
Set currentAppointment = myAppointments.FindNext
Wend
Else
[add to Access recordset here]
End If
Next

My question is this: How do I Restrict on more than one criteria? I'm only
interested in the appointment if Location IsNumeric and if [Start] is
between myStartDate and myEndDate. Also, am I handling the extraction of
recurring appointments properly by putting the While loop inside the For
Each loop?

If I set the Restrict criteria first, will I still need the Find criteria?
For example, would something like this work:

Set olir = olns.GetDefaultFolder(olFolderCalendar).Items
Set oli = oliRct.Restrict("IsNumeric([Location]) And _
[Start] >= " & Chr(34) & myStartDate & " and [Start] <= " & _
Chr(34) & myEndDate & Chr(34))

'now the set is narrowed, so no While loop is needed (?)
oli.IncludeRecurrences.True
For Each objItem in oli
[add to Access recordset here]
Next

Thanks in advance for your help.
 
Restrict and Find do not support Like or functions like IsNumeric. You can
only use the =, <, >, <= and >= operators. Join multiple search expressions
with AND or OR. (HINT: Test whether Location >= "1" and <= "A")

Don't forget that you need to use Sort before IncludeRecurrences and both
should go before your Restrict statement. Restrict returns an Items
collection. You can iterate it with a For Each ... Next loop:

objItems.Sort "[Start]"
objItems.IncludeRecurrences
Set colResult = objItems.Restrict(strSearch)
For Each objItem in colResult
' do stuff with objItem
Next
--
Sue Mosher, Outlook MVP
Author of
Microsoft Outlook Programming - Jumpstart for
Administrators, Power Users, and Developers



deko said:
You might find the information at http://www.outlookcode.com/d/finddate.htm
useful. It suggests some refinements.
Click to expand...

I wish I had known about Find and Restrict earlier :)

The MS documentation says: "The Restrict method is significantly faster if
there is a large number of items in the collection, especially if only a
few
items in a large collection are expected to be found."
(http://msdn.microsoft.com/library/default.asp?url=/library/en-us/vbaol11/ht
ml/olmthRestrict.asp)

But I'm kind of lost trying to put Restrict into action along with
IncludeRecurrences.

What I'm trying to do is integrate the OL calendar with an Access Contact
Management Database (mdb). The idea is to allow users to set, get, update
and delete appointments from within Access. This provides automatic
association of appointments with contacts in the mdb.

One of the challenges in doing this is finding a way to differentiate
"Access" appointments from "Outlook" appointments - so users can still use
the OL calendar as normal but can easily recognize appointments that
"belong
to the database", so to speak. So what I did was use the Location field
to
store the Entity_ID of the database record. I could have used a different
field, but Location was clearly visible on the default Outlook appointment
form (I wanted to avoid custom forms); the downside, obviously, is that
you
cannot use the Location field.

Now let's try it with the Restrict Method:

Dim ola As Outlook.AppointmentItem
Dim olaRcr As Outlook.AppointmentItem
Dim oli As Outlook.Items
Dim oliRcr as Outlook.Items
Dim oliRct As Outlook.Items
Dim rcrAppt As Outlook.Items
Dim objItem As Object

Set olir = olns.GetDefaultFolder(olFolderCalendar).Items
Set oli = oliRct.Restrict("[Location] Like '#'") '?????
'can I use more than one Restrict criteria?
oli.IncludeRecurrences.True
For Each objItem in oli
If objItem.IsRecurring Then
Set oliRcr = olns.GetDefaultFolder(olFolderCalendar).Items
Set oliRcr.IncludeRecurrences = True
Set olaRcr = oliRcr.Find("[Start] >= " & Chr(34) & _
myStartDate & " and [Start] <= " & Chr(34) & myEndDate & Chr(34))
While TypeName(olaRcr) <> "Nothing" [add to Access
recordset here]
Set currentAppointment = myAppointments.FindNext
Wend
Else
[add to Access recordset here]
End If
Next

My question is this: How do I Restrict on more than one criteria? I'm
only
interested in the appointment if Location IsNumeric and if [Start] is
between myStartDate and myEndDate. Also, am I handling the extraction of
recurring appointments properly by putting the While loop inside the For
Each loop?

If I set the Restrict criteria first, will I still need the Find criteria?
For example, would something like this work:

Set olir = olns.GetDefaultFolder(olFolderCalendar).Items
Set oli = oliRct.Restrict("IsNumeric([Location]) And _
[Start] >= " & Chr(34) & myStartDate & " and [Start] <= " & _
Chr(34) & myEndDate & Chr(34))

'now the set is narrowed, so no While loop is needed (?)
oli.IncludeRecurrences.True
For Each objItem in oli
[add to Access recordset here]
Next

Thanks in advance for your help.
Click to expand...
 
Restrict and Find do not support Like or functions like IsNumeric. You can
only use the =, <, >, <= and >= operators. Join multiple search expressions
with AND or OR. (HINT: Test whether Location >= "1" and <= "A")
Click to expand...

Sounds good.
Don't forget that you need to use Sort before IncludeRecurrences and both
should go before your Restrict statement. Restrict returns an Items
collection. You can iterate it with a For Each ... Next loop:
Click to expand...

So it sounds like IncludeRecurrences is all that's needed to Include
Recurrences - go figure :)
objItems.Sort "[Start]"
objItems.IncludeRecurrences
Set colResult = objItems.Restrict(strSearch)
For Each objItem in colResult
' do stuff with objItem
Next
Click to expand...

I'll give it a shot and post back.

Thanks!
 
Restrict and Find do not support Like or functions like IsNumeric. You can
only use the =, <, >, <= and >= operators. Join multiple search expressions
with AND or OR. (HINT: Test whether Location >= "1" and <= "A")

Don't forget that you need to use Sort before IncludeRecurrences and both
should go before your Restrict statement. Restrict returns an Items
collection. You can iterate it with a For Each ... Next loop:
Click to expand...

This seems to do the trick:

Dim obj As Object
Dim olItms As Outlook.Items
Dim olAptItm As Outlook.AppointmentItem

Set olItms = olns.GetDefaultFolder(olFolderCalendar).Items
olItms.Sort "[Start]"
olItms.IncludeRecurrences = True
Set obj = olItms.Restrict(strSearch)
For Each olAptItm In obj
[add to Access recordset here]
Next

Please let me know if I've missed something.

I've been using this as a search string:

[Start] >= "12/23/2003" AND [Start] <= "12/22/2005" AND [Location] > '1' AND
[Location] < 'A'

But if a non-Access appointment has a Location of, say, "900 South Street",
it still gets recognized an an Access appointment. So I'm thinking about
modifying the code that exports appointments to Outlook so that it puts a
value in some other Outlook field such as "Organizer". Perhaps then I could
use a string like:

[Start] >= "12/23/2003" AND [Start] <= "12/22/2005" AND [Organizer] = "oxp"

Even so, I'd keep the Entity_ID in the Location field since this enables
users to create an "Access" appointment from the Outlook Calendar simply by
putting an Entity_ID in the Location field.

In any case, Restrict and IncludeRecurrences have made a big improvement.

Thanks for the help!
 
You cannot set the value of the Organizer field. Outlook does that when the
item is created.

All Outlook items have two text fields that aren't used for anything in
particular - BillingInformation and Mileage. Those aren't visible on the
default form, but you can set and read them programmatically like any other
fields.

--
Sue Mosher, Outlook MVP
Author of
Microsoft Outlook Programming - Jumpstart for
Administrators, Power Users, and Developers



deko said:
Restrict and Find do not support Like or functions like IsNumeric. You
can
only use the =, <, >, <= and >= operators. Join multiple search expressions
with AND or OR. (HINT: Test whether Location >= "1" and <= "A")

Don't forget that you need to use Sort before IncludeRecurrences and both
should go before your Restrict statement. Restrict returns an Items
collection. You can iterate it with a For Each ... Next loop:
Click to expand...

This seems to do the trick:

Dim obj As Object
Dim olItms As Outlook.Items
Dim olAptItm As Outlook.AppointmentItem

Set olItms = olns.GetDefaultFolder(olFolderCalendar).Items
olItms.Sort "[Start]"
olItms.IncludeRecurrences = True
Set obj = olItms.Restrict(strSearch)
For Each olAptItm In obj
[add to Access recordset here]
Next

Please let me know if I've missed something.

I've been using this as a search string:

[Start] >= "12/23/2003" AND [Start] <= "12/22/2005" AND [Location] > '1'
AND
[Location] < 'A'

But if a non-Access appointment has a Location of, say, "900 South
Street",
it still gets recognized an an Access appointment. So I'm thinking about
modifying the code that exports appointments to Outlook so that it puts a
value in some other Outlook field such as "Organizer". Perhaps then I
could
use a string like:

[Start] >= "12/23/2003" AND [Start] <= "12/22/2005" AND [Organizer] =
"oxp"

Even so, I'd keep the Entity_ID in the Location field since this enables
users to create an "Access" appointment from the Outlook Calendar simply
by
putting an Entity_ID in the Location field.

In any case, Restrict and IncludeRecurrences have made a big improvement.

Thanks for the help!
Click to expand...
 
You cannot set the value of the Organizer field. Outlook does that when
the
item is created.

All Outlook items have two text fields that aren't used for anything in
particular - BillingInformation and Mileage. Those aren't visible on the
default form, but you can set and read them programmatically like any other
fields.
Click to expand...

I've used the BillingInformation field to identify "Transaction
Appointments" - which contain dollar figures that go into a separate table
for calculation.

But "Regular" appointments, I've decided, should not be separated between
Access appointments and Outlook appointments - because I want to display all
appointments (whether created in Outlook or Access) in my "All Appointments"
Access Datasheet.

Thanks again for the help and Merry Christmas!!

Here's my code that syncs up Access appointments with Outlook appointments:

'create new tblAppointments and retrieve all appointments from
Outlook
Call MakeTblAppts
Set rstAppt = db.OpenRecordset("tblAppointments") 'empty recordset
strSearchDate = "[Start] >= " & Chr(34) & dtmStart & Chr(34) & " AND
[Start] <= " & Chr(34) & dtmEnd & Chr(34)
Set olItms = olns.GetDefaultFolder(olFolderCalendar).Items
olItms.Sort "[Start]"
olItms.IncludeRecurrences = True '===== *** ====='
Set obj = olItms.Restrict(strSearchDate) 'get everything in
appointment window
For Each olAptItm In obj
'check pending tx appointments
'if updated made in Access, make changes in Outlook
If IsNumeric(olAptItm.BillingInformation) Then
'Debug.Print olAptItm.BillingInformation
deleted = True 'assume appt has been deleted in Access
rstAptx.MoveFirst
Do Until rstAptx.EOF 'check if tx appt is still in
tblAppointmentsPendingTx
If olAptItm.BillingInformation = rstAptx!Tx_ID Then
deleted = False 'appt is still there in outlook
If rstAptx!UpdatedInAccess = -1 And
rstAptx!AddedToOutlook = -1 Then
'appt has been changed, so update in outlook
With olAptItm
.Start = rstAptx!Start
.Subject = rstAptx!Subject
.Location = rstAptx!Location
.Body = rstAptx!Body
'If rstAptx!RecurrenceType Then Call
RecurringAppt(olatx, rstAptx)
.Save
.Close (olSave)
End With
End If
rstAptx.Edit
rstAptx!UpdatedInAccess = 0
rstAptx.Update
End If
rstAptx.MoveNext
Loop
'if pending TxAppt in Outlook is not found in
'tblAppointmentsPendingTx, delete it from Outlook
If deleted Then olAptItm.Delete
End If
If Not deleted Then
'get all regular appointments currently in Outlook
If Not IsNumeric(olAptItm.Location) Or
IsNull(olAptItm.Location) Then
'using this condition (instead of someOtherOlField =
"myValue")
'allows user to add appt with Eid Location directly from
ol calendar
'appts with invalid Eid will be screened out in Access
anyway
varAloc = 0
Else
varAloc = olAptItm.Location
End If
With rstAppt
.AddNew
!Entity_ID = varAloc
If Format(TimeValue(CDate(olAptItm.Start)), "Medium
Time") <> "12:00 AM" _
Then !ApptTime =
Format(TimeValue(CDate(olAptItm.Start)), "Medium Time")
!ApptDate = Format(DateValue(CDate(olAptItm.Start)),
"Short Date")
!ApptDay = Format(DateValue(CDate(olAptItm.Start)),
"ddd")
!Subject = olAptItm.Subject
.Update
End With
End If
Next
 
All Outlook items have two text fields that aren't used for anything in
particular - BillingInformation and Mileage. Those aren't visible on the
default form, but you can set and read them programmatically like any other
fields.
Click to expand...

Not sure if you're still watching this thread, but I was wondering if ou
could give me any pointers on adding appointments (and also recurring
appointments) to Outlook. The order appears to be important - AllDayEvents
do not get set if it's not right. Also, end date appears to be required.
But what if it's a recurring appt? Do I calculate the end date for the
appointment item, and also a start date for the RecurrencePattern? In what
order would I add these?

Do While Not rstApnd.EOF
Set olapn = ol.CreateItem(olAppointmentItem)
With olapn
If IsNull(rstApnd!RecurrenceType) Then
.start = rstApnd!start
.End = rstApnd!End
Else
' need end date - calculate by duration?
.AllDayEvent = rstApnd!AllDayEvent
Call RecurringAppt(olapn, rstApnd) --shd allDayEvent be set
before calling this?
End If
.AllDayEvent = rstApnd!AllDayEvent
.Subject = rstApnd!Subject
.Location = rstApnd!Location
.Body = rstApnd!Body
.ReminderSet = rstApnd!ReminderSet
.ReminderMinutesBeforeStart = rstApnd!ReminderMinutes
.Save
.Close (olSave)
End With
rstApnd.Delete
rstApnd.MoveNext
'after appt is added to Outlook, it is deleted from Access
'this avoids any inconsistency between the two interfaces.
'tblAppointments is recreated on each FullSync so any additions
'updates or changes are reflected in Access.
Loop

Thanks in advance.
 
End defines the duration of an individual appointment. It is not the end of
the recurrence pattern.

I think I usually set AllDayEvent, then End.
--
Sue Mosher, Outlook MVP
Author of
Microsoft Outlook Programming - Jumpstart for
Administrators, Power Users, and Developers
 
Back
Top