• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 736
  • Last Modified:

Retrieving Recurring Items from Outlook Calendar using VBA

I am using the following code to retrieve Outlook calendar items and store them into an Access 2007 table. This code works correctly for non-Recurring Items.

Private Sub RetrieveOutlookEntries_Click()
Dim OutObj As Outlook.Application        
Dim OutAppt As Outlook.AppointmentItem      
Dim OutItems As Outlook.Items
Dim ItemFilter As Variant

Set OutObj = CreateObject("Outlook.Application")
Set objNS = OutObj.GetNamespace("MAPI")
Set objFolder = objNS.GetDefaultFolder(olFolderCalendar)
Set OutItems = objFolder.Items

OutItems.Sort "[Start]"

For Each OutAppt In OutItems
  If OutAppt.Start >= "1/1/2013" And OutAppt.Start <= "1/25/2013" Then
    db.execute "INSERT INTO TempOutlookEntries ( ) VALUES ()
  End If
 
Next

Set OutAppt = Nothing
Set objFolder = Nothing
Set objNS = Nothing
Set OutObj = Nothing
End Sub

1) Are the following statements causing the Recurring Items to not be included?
Dim OutAppt As Outlook.AppointmentItem      
Dim OutItems As Outlook.Items

2) Does additional code need to be added to process the Recurring Items?

Thanks.
0
newbie46
Asked:
newbie46
  • 2
  • 2
1 Solution
 
Rey Obrero (Capricorn1)Commented:
Set OutItems = objFolder.Items

 outItems.IncludeRecurrences = True     '  add this line


OutItems.Sort "[Start]"
0
 
newbie46Author Commented:
capricorn1,

With that added statement, the code continuously loops through:

For Each OutAppt In OutItems
  If OutAppt.Start >= "1/1/2013" And OutAppt.Start <= "1/25/2013" Then
    db.execute "INSERT INTO TempOutlookEntries ( ) VALUES ()
  End If

When I break to stop the code from executing, click Debug and then hit F8, it is still cycling through the If - End If.

The execution never ends. Is there a way to limit the OutItems that it is processing?
0
 
Rey Obrero (Capricorn1)Commented:
Private Sub RetrieveOutlookEntries_Click()
Dim OutObj As Outlook.Application        
Dim OutAppt As Outlook.AppointmentItem      
Dim OutItems As Outlook.Items
Dim ItemFilter As Variant

Dim outItemsInDateRange As Outlook.Items
Dim strRestriction As String
Dim outFinalItems As Outlook.Items

Set OutObj = CreateObject("Outlook.Application")
Set objNS = OutObj.GetNamespace("MAPI")
Set objFolder = objNS.GetDefaultFolder(olFolderCalendar)
Set OutItems = objFolder.Items

outItems.IncludeRecurrences = True

strRestriction = "[Start] >= '1/1/2013' AND [End] <= '1/25/2013'"

OutItems.Sort "[Start]"

Set outItemsInDateRange = outItems.Restrict(strRestriction)
Set outFinalItems = outItemsInDateRange

outFinalItems.Sort "[Start]"

For Each OutAppt In OutFinalItems
  'If OutAppt.Start >= "1/1/2013" And OutAppt.Start <= "1/25/2013" Then
   

    db.execute "INSERT INTO TempOutlookEntries ( ) VALUES ()
  'End If
 
Next

Set OutAppt = Nothing
Set objFolder = Nothing
Set objNS = Nothing
Set OutObj = Nothing
End Sub
0
 
newbie46Author Commented:
Thank you, capricorn1. That worked!!
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Cloud Class® Course: Certified Penetration Testing

This CPTE Certified Penetration Testing Engineer course covers everything you need to know about becoming a Certified Penetration Testing Engineer. Career Path: Professional roles include Ethical Hackers, Security Consultants, System Administrators, and Chief Security Officers.

  • 2
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now