Solved

How to handle recurrence exceptions when exporting to Access

Posted on 2003-11-06
5
205 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

Free Tool: SSL Checker

Scans your site and returns information about your SSL implementation and certificate. Helpful for debugging and validating your SSL configuration.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

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

Suggested Solutions

Read this checklist to learn more about the 15 things you should never include in an email signature.
How to resolve IMCEAEX NDRs in Exchange or Exchange Online related to invalid X500 addresses.
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
Many of my clients call in with monstrous Gmail overloading issues with Outlook. A quick tip is to turn off the All Mail and Important folders from synching. Here is a quick video I made to show you how to turn off these and other folders in Gmail s…

807 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