Solved

How to handle recurrence exceptions when exporting to Access

Posted on 2003-11-06
5
202 Views
Last Modified: 2010-04-08
Well I thought I had this figured out, but I figured wrong.
I'm trying to export a Calendar object to an Access database through code.  The problem is that most events are recurring events.
I could get the start date and number of occurences and frequency and add these records to the database, but what about exceptions to the occurrence.  In some cases the description is different.  Or may week 7 of a ten week recurrence has been deleted.
Here's my basic code for getting the record, but of course now this code will only get the first instance of a recurring appointment.


Dim ol As New Outlook.Application
    Dim rst As DAO.Recordset
   Set rst = CurrentDb.OpenRecordset("Calendar")
    Dim olns As Outlook.NameSpace
    Dim cf As Outlook.MAPIFolder
   Dim c As Outlook.AppointmentItem
   Dim objItems As Outlook.Items
   Set olns = ol.GetNamespace("MAPI")
    Set cf = olns.Folders("PRC").Folders("Calendar")

   Set objItems = cf.Items
   iNumContacts = objItems.Count
   If iNumContacts <> 0 Then
      For i = 1 To iNumContacts
            Set c = objItems(i)
                If c.Sensitivity = olNormal Then 'ignore private records
                    rst.AddNew
                    rst!Subject = c.Subject
                    rst!StartDate = DateValue(c.Start)
                    rst!StartTime = TimeValue(c.Start)
                    rst!enddate = DateValue(c.End)
                    rst!EndTime = TimeValue(c.End)
                    rst!AllDayEvent = c.AllDayEvent
                    rst!Categories = c.Categories
                    rst!Description = c.Body
                    rst!Location = c.Location
                    rst.Update
                End If
      Next i
      rst.Close
      MsgBox "Finished."
   Else
      MsgBox "No items to export."
   End If
0
Comment
Question by:Mach1pro
  • 3
  • 2
5 Comments
 
LVL 9

Accepted Solution

by:
svenkarlsen earned 300 total points
ID: 9699092
Try this:

 . . . .
 . . . .

  Set objItems = cf.Items
  objItems.IncludeRecurrences = True
  objItems.Sort "[Start]"

   If InumContacts <> 0 Then

 . . . .
 . . .
0
 
LVL 6

Author Comment

by:Mach1pro
ID: 9700772
That looks like it would work except now I have 2147483647 appointment items to sort through.
Is there a way to put a date range filter on the items before starting? I tried this approach, but it coughed back an error:

objItems.Restrict "[start]between #10/1/03# and #3/1/04#"
0
 
LVL 9

Expert Comment

by:svenkarlsen
ID: 9701249
OK, - no worries, just do (set the filter acc to your need):

strStartDate = InputBox("Enter the first day for which you want to see appointments")
strEndDate = InputBox("Enter the last day for which you want to see appointments")

strDateFilter = "[Start] >= '" & strStartDate & "' and [Start] < '" & strEndDate & " 11:59 pm'"

Set myAppts = myAppts.Restrict(strDateFilter)


Regards,
Sven
0
 
LVL 6

Author Comment

by:Mach1pro
ID: 9701718
Sven
I couldn't get your filter routine to work, but since the appointments are coming down in START order Including the Recurrences, I was able to modify my code to break out of the For so that the process didn't loop through 2 billion records.
Here's what I came up with

Dim dt As Date
Set objItems = cf.Items
objItems.IncludeRecurrences = True
objItems.Sort "[Start]"
 inumcontacts = objItems.Count
   If inumcontacts <> 0 Then
      For i = 1 To inumcontacts
        Set c = objItems(i)
        dt = DateValue(c.Start)
         If dt > DateAdd("d", 365, Date) Then
            Exit For
        End If
        If dt > #10/1/2003# Then
            If c.Sensitivity = olNormal Then 'ignore private records
                rst.AddNew
                rst!Subject = c.Subject
                rst!StartDate = dt
                rst!StartTime = TimeValue(c.Start)
                rst!enddate = DateValue(c.End)
                rst!EndTime = TimeValue(c.End)
                rst!AllDayEvent = c.AllDayEvent
                rst!Categories = c.Categories
                rst!Description = c.Body
                rst!Location = c.Location
                rst.Update
            End If
          End If
      Next i
      rst.Close
      MsgBox "Finished."
   Else
      MsgBox "No items to export."
   End If
0
 
LVL 9

Expert Comment

by:svenkarlsen
ID: 9701804
OK,

you could try:

strDateFilter = "[Start] >= #" & strStartDate & "# and [Start] < #" & strEndDate & " 23:59#"

Thanx for the points!

Regards,
Sven


0

Featured Post

Control application downtime with dependency maps

Visualize the interdependencies between application components better with Applications Manager's automated application discovery and dependency mapping feature. Resolve performance issues faster by quickly isolating problematic components.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Sometimes Outlook might have problems sending a message. There may be various causes- corrupted PST, AV scanner etc. The message, instead of going to the Sent Items folder, sits in the Outbox indefinitely. To remove it you can use a free tool cal…
Read this checklist to learn more about the 15 things you should never include in an email signature.
This Experts Exchange video Micro Tutorial shows how to tell Microsoft Office that a word is NOT spelled correctly. Microsoft Office has a built-in, main dictionary that is shared by Office apps, including Excel, Outlook, PowerPoint, and Word. When …
CodeTwo Sync for iCloud (http://www.codetwo.com/sync-for-icloud?sts=6554) automatically synchronizes your Outlook 2016, 2013, 2010 or 2007 folders with iCloud folders available via iCloud Control Panel. This lets you automatically sync them with…

911 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

20 Experts available now in Live!

Get 1:1 Help Now