Article ID: 178508
Article Last Modified on 7/15/2004
Option Explicit
Const strServer As String = "MyExchangeServer"
Const strMailbox As String = "MyMailbox"
Private Sub Command1_Click()
Dim objSession As MAPI.Session
Dim objCalendarFolder As Folder
Dim objAppointments As Messages
Dim objAppointmentFilter As MessageFilter
Dim objOneAppointment As AppointmentItem
Dim strProfileInfo As String
Dim StartTime As Date
Dim EndTime As Date
Dim objAppointmentFilterField1 As Field
Dim objAppointmentFilterField2 As Field
Screen.MousePointer = vbHourglass
StrProfileInfo = strServer & vbLf & strMailbox
Set objSession = New MAPI.Session
objSession.Logon , , False, False, 0, True, strProfileInfo
'Fill in a date/time using the vbDate format.
'For example StartTime = #1/1/98 9:30 AM#. This vbDate
'filters appointments that started AFTER 9:30 AM on
'January 1, 1998. Use StartTime and EndTime in combination
'to filter a specific date. For example, if you wanted to filter
'for all your appointments on January 1, 1998, use
'StartTime = #1/1/98#
'EndTime = #1/2/98#
'This combination filters for all appointments starting
'AFTER Janury 1, 1998 at midnight, and all appointments ending
'BEFORE January 2, 1998 at midnight.
'You can further refine your filter by adding times to the
'StartTime and EndTime.
StartTime = #m/d/yy hh:mm XX#
EndTime = #m/d/yy hh:mm XX#
Set objCalendarFolder = _
objSession.GetDefaultFolder(CdoDefaultFolderCalendar)
Set objAppointments = objCalendarFolder.Messages
Set objAppointmentFilter = objAppointments.Filter
'NOTE: Pass the EndTime parameter to the START_DATE field and the
' StartTime parameter to the END_DATE field.
Set objAppointmentFilterField1 = _
objAppointmentFilter.Fields.Add(CdoPR_START_DATE, EndTime)
Set objAppointmentFilterField2 = _
objAppointmentFilter.Fields.Add(CdoPR_END_DATE, StartTime)
For Each objOneAppointment In objAppointments
Debug.Print "objOneAppointment.Subject = " & _
objOneAppointment.Subject
Debug.Print "objOneAppointment.StartTime = " & _
objOneAppointment.StartTime
Debug.Print "objOneAppointment.EndTime = " & _
objOneAppointment.EndTime
Debug.Print
Next
objSession.Logoff
Set objOneAppointment = Nothing
Set objAppointments = Nothing
Set objCalendarFolder = Nothing
Set objSession = Nothing
Screen.MousePointer = vbNormal
End Sub
Keywords: kbhowto kbmsg kbcode KB178508