Solved

How to handle recurrence exceptions when exporting to Access

Posted on 2003-11-06
5
208 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 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

SuperAntiSpyware Licenses Discounted by 25% !

Exclusive offer to Experts Exchange Members!
Buy SuperAntiSpyware License(s) from us and save 25% on the regular purchase price.
- Includes Full SuperAntiSpyware Vendor Support Entitlements
- Your Subscription does not begin until you activate your license
- Buy for your friends

Question has a verified solution.

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

Suggested Solutions

Title # Comments Views Activity
Apple iCloud Accepting Meeting Reqeust causes issues 7 103
Outlook 2010 hyperlink issue 3 43
MS Exchange 2016 license 5 35
Exchange Online Archive 2 27
If you don't know how to downgrade, my instructions below should be helpful.
MS Outlook is a world-class email client application that is mainly used for e-communication globally.  In this article, we will discuss the basic idea about MS Outlook, its advanced features, and types of MS Outlook File formats.
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 …
This video shows how to remove a single email address from the Outlook 2010 Auto Suggestion memory. NOTE: For Outlook 2016 and 2013 perform the exact same steps. Open a new email: Click the New email button in Outlook. Start typing the address: …

751 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