Create a new class module and paste this code into it. Call the class module cOutlookCalendar
If you have any questions, email us at help@codeoftheweek.com
'----------------------------------------------------------------------
'
' Module Name: cOutlookCalendar
' Written By: C&D Programming Corp.
' Create Date: 8/2000
' Copyright: Copyright 2000 by C&D Programming Corp. Source
' code may not be reproduced except for use in a
' compiled executable. All rights reserved. If
' you would like to reprint any or all of this
' code please email us at info@codeoftheweek.com
'----------------------------------------------------------------------
Option Explicit
Private molApp As Outlook.Application
Private mdStart As Date
Private mdEnd As Date
'
' StartDate and EndDate defines the appointments that will be
' read by the GetAppointments routine.
'
Public Property Let StartDate(dStart As Date)
mdStart = dStart
End Property
Public Property Get StartDate() As Date
StartDate = mdStart
End Property
Public Property Let EndDate(dEnd As Date)
mdEnd = dEnd
End Property
Public Property Get EndDate() As Date
EndDate = mdEnd
End Property
'
' retrieve appointments between StartDate and EndDate and put them
' into the collection passed as colAppt
'
Public Sub GetAppointments(colAppt As Collection)
Dim oCalendarFolder As Outlook.MAPIFolder
Dim oAppt As Outlook.AppointmentItem
' retrieve the default calendar folder
Set oCalendarFolder = molApp.Session.GetDefaultFolder(olFolderCalendar)
' iterate through available appointment items
For Each oAppt In oCalendarFolder.Items
If (oAppt.Start > StartDate) And (oAppt.Start < EndDate) Then
colAppt.Add oAppt, oAppt.EntryID
End If
Next
End Sub
Private Sub Class_Initialize()
Set molApp = New Outlook.Application
' default to include everything
' (at least it will likely be everything)
StartDate = #1/1/90#
EndDate = #12/31/2050#
End Sub
Private Sub Class_Terminate()
Set molApp = Nothing
End Sub