Still celebrating National IT Professionals Day with 3 months of free Premium Membership. Use Code ITDAY17

x
?
Solved

How to handle recurrence exceptions when exporting to Access

Posted on 2003-11-06
5
Medium Priority
?
216 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 1200 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

VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

Question has a verified solution.

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

You need to know the location of the Office templates folder, so that when you create new templates, they are saved to that location, and thus are available for selection when creating new documents.  The steps to find the Templates folder path are …
This article will help to fix the below error for MS Exchange server 2010 I. Out Of office not working II. Certificate error "name on the security certificate is invalid or does not match the name of the site" III. Make Internal URLs and External…
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…
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 …

670 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