Finding all instances of recurring item - someone must have coded this ?

  • Thread starter Thread starter Composer
  • Start date Start date
C

Composer

With Office 2000 (Outlook 9.0), I am trying to step through all
occurrences of a recurring item using VBA.

I've followed some threads on this subject, and the answer seems to be
that I have to compute all the dates myself based on the
RecurrencePattern. In addition there is the Exceptions collection,
which thankfully acts as a normal Collection, but only has pointers to
the exceptional items in the series.

I am daunted by the prospect of programmatically computing all possible
combinations of Interval, Instance, DayOfWeekMask (which may have
multiple bits set), DayOfMonth, MonthOfYear ... and I suspect there are
other developers who have felt equally daunted.

Can anyone please tell me (a) whether the Outlook data model offers a
solution in a later release, or (b) where I could acquire a VBA module
that does this job?

Thanks.
 
G'DAY Composer,

The code below is presented 'as is' - I have not used it in
4 or 5 years.

It was behind an XL Sheet that I used to List Expenses.

The data came from Outlook, where a custom
appointment form used a couple of custom properties.

The Code sets up some dates, between which are the target
appointments - you may ignore this.

The essential feature for you, is the line:
ThisSet.IncludeRecurrences = True
which includes all recurrences (of any appointments).

The dates are in dd/mmm/yy format.
--
Regards,
Pat Garard
Melbourne, Australia
_______________________
=======================================
Sub ListAppointments()
Sheets("Expenses").Activate

' Declare all the variables
Dim olApplication As Outlook.Application
Dim olNameSpace As NameSpace
Dim objCalendar As Object
Dim objApptmt As Object
Dim myProp As Object
Dim ThisSet As Object
Dim Today As Date
Dim EndDay As Date
Dim DaysToSaturday As Integer
Dim getError As Integer
Dim Criteria As String

' Start Outlook and target the Calendar
getError = 0
On Error GoTo NotRunning
Set olApplication = GetObject(, "Outlook.Application")
NotRunning:
If Err.Number = 429 Then
Set olApplication = CreateObject("Outlook.Application")
getError = Err.Number
End If
On Error GoTo 0
Set olNameSpace = olApplication.GetNamespace("MAPI")
Set objCalendar = olNameSpace.GetDefaultFolder(olFolderCalendar)

' What is the date? Calculate to NEXT Saturday
Today = Now()
DaysToSaturday = 7 - WeekDay(Today)
EndDay = Format(DateAdd("d", DaysToSaturday, Now()), "dd/mm/yy")
' Focus on Appointment Items and Recurrences
Set ThisSet = objCalendar.Items
' ... and Restrict it.
Criteria = "[Start] < ""#" & EndDay & "#"" And [Sensitivity] <> 2" '
Const olPrivate = 2
Set ThisSet = ThisSet.Restrict(Criteria)
' Sort and include recurrences
ThisSet.Sort "[Start]"
ThisSet.IncludeRecurrences = True

' Lets see whats happening, ...
Application.ScreenUpdating = True
' ... focus on the right spot, ...
Sheets("Expenses").Activate
' ... and clear the decks!
Range("C1").Value = EndDay
ActiveSheet.Range("A5").CurrentRegion.ClearContents
' Lets do it
Range("A5").Select
For Each objApptmt In ThisSet
With objApptmt
' Only non-Holiday, uninvoiced appointments
If InStr(1, .Categories, "Holiday") = 0 Then
' Fix any stray recurrences without User Props
If .UserProperties.Count = 0 Then
' We need to know so we can fix Outlook vbScript
MsgBox .Subject & Str(.Start), vbOKOnly, "No User
Properties"
Set myProp = .UserProperties.Add("Parking", olCurrency)
myProp.Value = 0
Set myProp = .UserProperties.Add("Meals", olCurrency)
myProp.Value = 0
Set myProp = .UserProperties.Add("Invoiced", olYesNo)
myProp.Value = olNoFlag
.Save
End If
' Now list the expenses
If .UserProperties("Invoiced") = False Then
ActiveCell.Value = CDate(.Start)
ActiveCell.Offset(0, 1).Activate
ActiveCell.Value = CStr(.Subject)
ActiveCell.Offset(0, 1).Activate
ActiveCell.Value = CStr(.Location)
ActiveCell.Offset(0, 1).Activate
ActiveCell.Value = CStr(.Mileage)
ActiveCell.Offset(0, 1).Activate
ActiveCell.Value = CCur(.UserProperties("Parking"))
ActiveCell.Offset(0, 1).Activate
ActiveCell.Value = CCur(.UserProperties("Meals"))
ActiveCell.Offset(0, 1).Activate
ActiveCell.Value = CBool(.UserProperties("Invoiced"))
ActiveCell.Offset(1, -6).Activate
End If
End If
End With
Next
Set olApplication = Nothing
Range("A5").Select
End Sub
=======================================
 
Tausen Dank, Michael Bauer!
G'day, Pat Garard!

You guys have saved me.

I hadn't been aware of .IncludeRecurrences, even though I thought I had
looked through the Object Browser thoroughly. Guess I'd better go out
and buy an Outlook expert's book.

I did try .Restrict, Pat, but was put off because it seems to require
an all-numeric date. I've found that when I distribute an app to
several people, some of them have their dates set to mm/dd/yy and
others to dd/mm/yy, and there have been failures due to this. So now I
always format every date as "dd mmm yyyy" to force VBA (or SQL) to
recognise which part is the month. And because I'm such a coward, I
don't seem to be able to get .Restrict to work. Oh well, my code is
now functional.

Thanks again.

PS. What's this DevelopersDex all about? I posted my question to
microsoft.public.outlook.program_vba and your responses came to me via
"DevelopersDex Newsgroup Service".
 
G'Day Composer,

Glad to help.

There is an old saying - Discretion is the better part of Valour -
so sometimes being a coward is good!!

If you do buy a book, look for one by Sue Mosher - see her site:
http://www.outlookcode.com/.

I've never heard of DevelopersDex, but there seem to be some
neat cross-links between different 'front end' newsgroups.

Travel Well, my friend!!
 
Back
Top