Filtering and Viewing Calendars (CDOEX and ADO)

Visual Basic

' Filtering and viewing calendars using CDOEx and ADO
' This sample demonstrates how to filter and view the appointments from a Calendar folder using 
' CDO, ADO, and ADSI.
' It opens the Calendar folder using an ADODB record. It filters the appointments
' to include the ones that meet the following selection criteria:
'
' - The status of the appointment is marked as Busy, and
' - The appointment occurs in between 12.25.1999 - 8:00:00 AM and 12.29.1999 - 8:00:00 AM, and
' - The appointment is a single appointment (that is, not part of a recurring appointment).
'
' At the end, the sample prints the subject, location, and attendees of
' each appointment item matching the selection criteria.
'
' Visual Basic Project Reference
' - Microsoft CDO for Exchange 2000 Library
' - Microsoft ActiveX Data Objects 2.5 Library
' - Active DS Type Library

Private Sub FilterAppointments(User1)
Dim CalendarURL As String
Dim ItemURL As String
Dim Rs As New ADODB.Recordset
Dim Rec As New ADODB.Record
Dim iAppt As New CDO.Appointment
Dim iAttendees As Object
Dim DebugStr As String
Dim DomainName As String
Dim info As New ADSystemInfo

' Get the domain name.
DomainName = info.DomainDNSName

' Construct the URL that will be used to reach the specified Calendar folder.
' Note: You can view a calendar folder belonging to someone else (or a public folder),
' as long as the mailbox of that user (or the public folder) resides in the local 
' computer and you have sufficient permissions to view it.

' If the Calendar folder is a public folder, the CalendarURL string will look like the following: 
' CalendarURL = "file://./backofficestorage/" & DomainName & "/public folders/" & "NameOfTheCalendarFolder"

CalendarURL = "file://./backofficestorage/" & DomainName & "/MBX/" & User1 & "/calendar/"

'Open a recordset for the items in the calendar folder.
Rec.Open CalendarURL

Set Rs.ActiveConnection = Rec.ActiveConnection
Rs.Source = "SELECT ""DAV:href"", " & _
" ""urn:schemas:calendar:busystatus"", " & _
" ""urn:schemas:calendar:instancetype"", " & _
" ""urn:schemas:calendar:dtstart"", " & _
" ""urn:schemas:calendar:dtend"" " & _
"FROM scope('shallow traversal of """ & CalendarURL & """') " & _
"WHERE (""urn:schemas:calendar:dtstart"" >= CAST(""1999-12-25T08:00:00Z"" as 'dateTime')) " & _
"AND (""urn:schemas:calendar:dtend"" <= CAST(""1999-12-29T08:00:00Z"" as 'dateTime'))" & _
"AND (""urn:schemas:calendar:busystatus"" = 'Busy')" & _
"AND (""urn:schemas:calendar:instancetype"" = 0)"
Rs.Open
If Not (Rs.EOF) Then
Rs.MoveFirst
DebugStr = ""

' Enumerate the recordset, printing some information about each item.
Do Until Rs.EOF

' Find the absolute uniform resource locator (URL) of each item.
ItemURL = Rs.Fields(CdoDAV.cdoHref).Value

' Open the appointment using its URL.
iAppt.DataSource.Open ItemURL

DebugStr = DebugStr & "Subject: " & iAppt.Subject & vbLf
DebugStr = DebugStr & "Start-End Time: " & iAppt.StartTime & " - " & iAppt.EndTime & vbLf
DebugStr = DebugStr & "Location: " & iAppt.Location & vbLf
DebugStr = DebugStr & "Attendees: "

' Find the attendees who are invited to each meeting.
Set iAttendees = iAppt.Attendees
For i = 1 To iAttendees.Count
DebugStr = DebugStr & iAttendees(i).DisplayName & " "
DebugStr = DebugStr & vbLf & vbLf
Rs.MoveNext
Loop
Debug.Print DebugStr

' No appointments were found that match the search criteria.
Else 
Debug.Print "No Appointments found."
End If
End Sub