B
baggers
I am creating an application that displays appointments from a public folder
calendar, to expose XML that contains the appointment start date & time, and
the subject, etc.
The app could reside on the exchange server or on any other server that can
access the exchange server, but I'm trying to avoid using the Outlook
application to accomplish this, so I'm trying CDO/MAPI.
Here's the Scenario:
I create a Calendar in a Public Folder.
I add 15000 appointments in the calendar over a period of several years.
I know the EntryId and StoreID for the Calendar I've created (thanks
OutlookSpy).
Here is my sample code to date:
Private Sub VisualMapi()
Dim oSession As MAPI.Session
Dim oStores As MAPI.InfoStores
Dim oStore As MAPI.InfoStore
Dim oRoot As MAPI.Folder
Dim oFolders As MAPI.Folders
Dim oFolder As MAPI.Folder
Dim oMsgs As MAPI.Messages
Dim oItem As MAPI.MeetingItem
Dim oMsg As MAPI.Message
Dim oAppt As MAPI.AppointmentItem
Dim oFilter As MAPI.MessageFilter
Dim iLooper As Integer
Dim strFilter As String
lstAppointments.Clear
lblTrace.Caption = vbNullString
'create a session object if we don't have one already
If oSession Is Nothing Then
Set oSession = New MAPI.Session
'logon to the session
oSession.Logon
End If
'get a reference to the info stores collection
Set oStores = oSession.InfoStores
'check for error
If Not oStores Is Nothing Then
Set oFolder = oSession.GetFolder("{Entry ID}", "{Store ID}")
Debug.Print vbCrLf & "This is the Folder : " & oFolder.Name
End If
'get the messages collection of the folder
'make sure there's some folders there
If Not oFolder Is Nothing Then
'get a reference to the messages collection
Set oMsgs = oFolder.Messages
'make sure we have some messages
If Not oMsgs Is Nothing Then
'get the messages filter for the messages collection
' 'oFilter is used as the Filter object; it needs to be DIM'd in
your code
Set oFilter = oMsgs.Filter
'set filter criteria
Debug.Print vbCrLf & "-------Filter on the day 30/06/2009 @ " &
Now & " --------"
' oFilter.TimeFirst = CDate("30/06/2009 00:00:01")
' oFilter.TimeLast = CDate("30/06/2009 23:59:59")
'OR
' oFilter.Fields.Add CdoPR_START_DATE, CDate("28/06/2009")
' oFilter.Fields.Add CdoPR_END_DATE, CDate("27/06/2009")
Dim sRestrict As String
Dim dteDate As Date
Dim strWhere As String
dteDate = CDate(Now)
oMsgs.Sort CdoAscending, CdoPR_START_DATE
' strWhere = "Start = " & SingleQuote(Format(dteDate,
"yyyy-mm-dd") & " 00:00:00") & " AND Start < " & SingleQuote(Format(dteDate +
1, "yyyy-mm-dd") & " 00:00:00")
' sRestrict = "select * from Folder Where " & strWhere
sRestrict = "(" & DoubleQuote("urn:schemas:calendar:dtstart") &
" > " & SingleQuote("30/06/2009 00:00") & " AND " &
DoubleQuote("urn:schemas:calendar:dtstart") & " < " & SingleQuote("01/07/2009
00:00") & ")"
' sRestrict = " (%today(""urn:schemas:calendar:dtstart"")%)"
Debug.Print sRestrict
??? oFilter. (sRestrict)
'loop through all the filtered messages
For Each oMsg In oMsgs
'get information on each message
' If TypeOf oMsg Is MAPI.AppointmentItem Then
Debug.Print "START: " & oMsg.FolderID & vbTab &
"SUBJECT: " & oMsg.Subject '??? NEED to display the start date/time and
duration, as well as the subject.
' End If
Next
End If
End If
'empty all object references when done!
tidy_up:
oSession.Logoff
Set oSession = Nothing
Set oStores = Nothing
Set oStore = Nothing
Set oRoot = Nothing
Set oFolders = Nothing
Set oFolder = Nothing
Set oMsgs = Nothing
Set oMsg = Nothing
Set oAppt = Nothing
Set oFilter = Nothing
End Sub
I have a problem at the two lines marked with ???
1. I cannot get the filter to work (several methods attempted as you can see
from commented code)
2. I cannot access the Start, End, Duration properties through MAPI.Message
object, so how do I get a MAPI.AppointmentItem object populated?
We need each query to take no more than 3 seconds (or maybe 5 seconds at
most).
I am stumped, can anyone here offer any advice.
Thanks (in advance)
calendar, to expose XML that contains the appointment start date & time, and
the subject, etc.
The app could reside on the exchange server or on any other server that can
access the exchange server, but I'm trying to avoid using the Outlook
application to accomplish this, so I'm trying CDO/MAPI.
Here's the Scenario:
I create a Calendar in a Public Folder.
I add 15000 appointments in the calendar over a period of several years.
I know the EntryId and StoreID for the Calendar I've created (thanks
OutlookSpy).
Here is my sample code to date:
Private Sub VisualMapi()
Dim oSession As MAPI.Session
Dim oStores As MAPI.InfoStores
Dim oStore As MAPI.InfoStore
Dim oRoot As MAPI.Folder
Dim oFolders As MAPI.Folders
Dim oFolder As MAPI.Folder
Dim oMsgs As MAPI.Messages
Dim oItem As MAPI.MeetingItem
Dim oMsg As MAPI.Message
Dim oAppt As MAPI.AppointmentItem
Dim oFilter As MAPI.MessageFilter
Dim iLooper As Integer
Dim strFilter As String
lstAppointments.Clear
lblTrace.Caption = vbNullString
'create a session object if we don't have one already
If oSession Is Nothing Then
Set oSession = New MAPI.Session
'logon to the session
oSession.Logon
End If
'get a reference to the info stores collection
Set oStores = oSession.InfoStores
'check for error
If Not oStores Is Nothing Then
Set oFolder = oSession.GetFolder("{Entry ID}", "{Store ID}")
Debug.Print vbCrLf & "This is the Folder : " & oFolder.Name
End If
'get the messages collection of the folder
'make sure there's some folders there
If Not oFolder Is Nothing Then
'get a reference to the messages collection
Set oMsgs = oFolder.Messages
'make sure we have some messages
If Not oMsgs Is Nothing Then
'get the messages filter for the messages collection
' 'oFilter is used as the Filter object; it needs to be DIM'd in
your code
Set oFilter = oMsgs.Filter
'set filter criteria
Debug.Print vbCrLf & "-------Filter on the day 30/06/2009 @ " &
Now & " --------"
' oFilter.TimeFirst = CDate("30/06/2009 00:00:01")
' oFilter.TimeLast = CDate("30/06/2009 23:59:59")
'OR
' oFilter.Fields.Add CdoPR_START_DATE, CDate("28/06/2009")
' oFilter.Fields.Add CdoPR_END_DATE, CDate("27/06/2009")
Dim sRestrict As String
Dim dteDate As Date
Dim strWhere As String
dteDate = CDate(Now)
oMsgs.Sort CdoAscending, CdoPR_START_DATE
' strWhere = "Start = " & SingleQuote(Format(dteDate,
"yyyy-mm-dd") & " 00:00:00") & " AND Start < " & SingleQuote(Format(dteDate +
1, "yyyy-mm-dd") & " 00:00:00")
' sRestrict = "select * from Folder Where " & strWhere
sRestrict = "(" & DoubleQuote("urn:schemas:calendar:dtstart") &
" > " & SingleQuote("30/06/2009 00:00") & " AND " &
DoubleQuote("urn:schemas:calendar:dtstart") & " < " & SingleQuote("01/07/2009
00:00") & ")"
' sRestrict = " (%today(""urn:schemas:calendar:dtstart"")%)"
Debug.Print sRestrict
??? oFilter. (sRestrict)
'loop through all the filtered messages
For Each oMsg In oMsgs
'get information on each message
' If TypeOf oMsg Is MAPI.AppointmentItem Then
Debug.Print "START: " & oMsg.FolderID & vbTab &
"SUBJECT: " & oMsg.Subject '??? NEED to display the start date/time and
duration, as well as the subject.
' End If
Next
End If
End If
'empty all object references when done!
tidy_up:
oSession.Logoff
Set oSession = Nothing
Set oStores = Nothing
Set oStore = Nothing
Set oRoot = Nothing
Set oFolders = Nothing
Set oFolder = Nothing
Set oMsgs = Nothing
Set oMsg = Nothing
Set oAppt = Nothing
Set oFilter = Nothing
End Sub
I have a problem at the two lines marked with ???
1. I cannot get the filter to work (several methods attempted as you can see
from commented code)
2. I cannot access the Start, End, Duration properties through MAPI.Message
object, so how do I get a MAPI.AppointmentItem object populated?
We need each query to take no more than 3 seconds (or maybe 5 seconds at
most).
I am stumped, can anyone here offer any advice.
Thanks (in advance)
