Enumerate Outlook items in mailbox using MAPI

[Greg J]

Hi,

I am trialling some code in Outlook VBA to see how fast I can read
through all items in a mailbox to get the current size. I have done
this successfully with the Outlook Object Model but have heard/read
that MAPI is much faster. The following code IS much faster and works
mostly but there are some Outlook items it simply refuses to read and
therefore I cannot get an accurate size of the Mailbox. The mailbox I
am using does not have a full compliment of all available item classes
but the list below is what I have uncovered so far.

I am working with Outlook 2003 and Exchange 2003. The error I receive
is -2147024891 [Collaboration Data Objects -
[E_ACCESSDENIED(80070005)]]

Errors Occur for Outlook Object Model Item Classes:
- MessageClass = IPM.Schedule.Meeting.Request (olMeetingRequest = 53)
- MessageClass = IPM.Schedule.Meeting.Canceled (olMeetingCancellation
= 54)
- MessageClass = IPM.Schedule.Meeting.Resp.Neg
(olMeetingResponseNegative = 55)
- MessageClass = IPM.Schedule.Meeting.Resp.Pos
(olMeetingResponsePositive = 56)
- MessageClass = IPM.Schedule.Meeting.Resp.Tent
(olMeetingResponseTentative = 57)

The error occurs on the line where I try to assign an item in the
MAPI.Messages collection to an Object variable, ie: Set Obj =
mpMsgs.Item(i)

Any ideas as to how I can read these items would be greatly
appreciated.

'Main function to find the Root folder for the Mailbox and initiate
enumeration of folders
Function MapiSizeCheck()

Dim mpSess As MAPI.Session
Dim mpRoot As MAPI.Folder
Dim strStoreID As String

Set mpSess = New MAPI.Session

mpSess.Logon "Outlook"

'Get the Store ID for the main Exchange mailbox
strStoreID =
mpSess.GetDefaultFolder(CdoDefaultFolderInbox).StoreID

'Get the root folder (IPM_SUBTREE) for the Exchange Mailbox
Set mpRoot = mpSess.GetInfoStore(strStoreID).RootFolder

'Initiate enumeration of the folders
fnGetFolderSizes mpRoot

'Clean up
Set mpRoot = Nothing
mpSess.Logoff
Set mpSess = Nothing

End Function

'Recursive function to read enumerate each Folder MAPI.Messages
collection
Function fnGetFolderSizes(mpFdr As MAPI.Folder)
On Error Resume Next

Dim mpSub As MAPI.Folder
Dim mpMsgs As MAPI.Messages
Dim Obj As Object

'Get the collection of items in the folder
Set mpMsgs = mpFdr.Messages

lngCount = mpMsgs.Count

'Get the item details if items exist
If lngCount > 0 Then

'Enumerate the items in the collection to get each items
details (class, size etc)
For i = 1 To mpMsgs.Count

'ERROR OCCURS ON THIS NEXT LINE
Set Obj = mpMsgs.Item(i)
'ERROR! -2147024891 [Collaboration Data Objects -
[E_ACCESSDENIED(80070005)]]

'do stuff with item here...

Next

End If

'If the folder has sub-folders, call this procedure for the sub-
folder
If mpFdr.Fields(CdoPR_SUBFOLDERS) Then
For Each mpSub In mpFdr.Folders
fnGetFolderSizes mpSub
Next
End If

'Cleanup
Set Obj = Nothing
Set mpMsgs = Nothing
Set mpSub = Nothing

End Function


Regards


Greg Johncock

 

[Dmitry Streblechenko]

How many items do you process before you get that error?

Dmitry Streblechenko (MVP)
http://www.dimastr.com/
OutlookSpy - Outlook, CDO
and MAPI Developer Tool

Hi,

I am trialling some code in Outlook VBA to see how fast I can read
through all items in a mailbox to get the current size. I have done
this successfully with the Outlook Object Model but have heard/read
that MAPI is much faster. The following code IS much faster and works
mostly but there are some Outlook items it simply refuses to read and
therefore I cannot get an accurate size of the Mailbox. The mailbox I
am using does not have a full compliment of all available item classes
but the list below is what I have uncovered so far.

I am working with Outlook 2003 and Exchange 2003. The error I receive
is -2147024891 [Collaboration Data Objects -
[E_ACCESSDENIED(80070005)]]

Errors Occur for Outlook Object Model Item Classes:
- MessageClass = IPM.Schedule.Meeting.Request (olMeetingRequest = 53)
- MessageClass = IPM.Schedule.Meeting.Canceled (olMeetingCancellation
= 54)
- MessageClass = IPM.Schedule.Meeting.Resp.Neg
(olMeetingResponseNegative = 55)
- MessageClass = IPM.Schedule.Meeting.Resp.Pos
(olMeetingResponsePositive = 56)
- MessageClass = IPM.Schedule.Meeting.Resp.Tent
(olMeetingResponseTentative = 57)

The error occurs on the line where I try to assign an item in the
MAPI.Messages collection to an Object variable, ie: Set Obj =
mpMsgs.Item(i)

Any ideas as to how I can read these items would be greatly
appreciated.

'Main function to find the Root folder for the Mailbox and initiate
enumeration of folders
Function MapiSizeCheck()

Dim mpSess As MAPI.Session
Dim mpRoot As MAPI.Folder
Dim strStoreID As String

Set mpSess = New MAPI.Session

mpSess.Logon "Outlook"

'Get the Store ID for the main Exchange mailbox
strStoreID =
mpSess.GetDefaultFolder(CdoDefaultFolderInbox).StoreID

'Get the root folder (IPM_SUBTREE) for the Exchange Mailbox
Set mpRoot = mpSess.GetInfoStore(strStoreID).RootFolder

'Initiate enumeration of the folders
fnGetFolderSizes mpRoot

'Clean up
Set mpRoot = Nothing
mpSess.Logoff
Set mpSess = Nothing

End Function

'Recursive function to read enumerate each Folder MAPI.Messages
collection
Function fnGetFolderSizes(mpFdr As MAPI.Folder)
On Error Resume Next

Dim mpSub As MAPI.Folder
Dim mpMsgs As MAPI.Messages
Dim Obj As Object

'Get the collection of items in the folder
Set mpMsgs = mpFdr.Messages

lngCount = mpMsgs.Count

'Get the item details if items exist
If lngCount > 0 Then

'Enumerate the items in the collection to get each items
details (class, size etc)
For i = 1 To mpMsgs.Count

'ERROR OCCURS ON THIS NEXT LINE
Set Obj = mpMsgs.Item(i)
'ERROR! -2147024891 [Collaboration Data Objects -
[E_ACCESSDENIED(80070005)]]

'do stuff with item here...

Next

End If

'If the folder has sub-folders, call this procedure for the sub-
folder
If mpFdr.Fields(CdoPR_SUBFOLDERS) Then
For Each mpSub In mpFdr.Folders
fnGetFolderSizes mpSub
Next
End If

'Cleanup
Set Obj = Nothing
Set mpMsgs = Nothing
Set mpSub = Nothing

End Function


Regards


Greg Johncock

 

[Greg J]

Hi Dmitry,

Thank you for your response to my problem.

Items processed before first error is 69 (about 4th folder). Errors
in folders can appear anywhere in the item collection, that is the
errors are not consistent with the start, end or middle of the
collections.

I have tried using the EntryID from OOM to open the message directly
and I get the same error.

I did omit to tell you that Outlook mailbox is as OST file.

Also, all folders where the errors are occurring have a default item
type of MailItem.

Regards


Greg J

 

[Dmitry Streblechenko]

Most likely you are running out of 255 RPC channels limit. Are you running
your code in a cached or online Exchange mode?
Do you *absolutely* need to touch each item in the folder? Do you process
only some messages that satify a certain criteria?

Dmitry Streblechenko (MVP)
http://www.dimastr.com/
OutlookSpy - Outlook, CDO
and MAPI Developer Tool

 

[Greg J]

Hi Dmitry,

The reason I am reading through each item is to get the total size for
the mailbox. I have found scripts that say you can get the size of
all items in a folder from the folder object but I cannot seem to get
this to work and your OutlookSpy tool has no reference to a property
on the folder object that contains the size of the folder. So I am
guessing the only way to do this is to iterate through each item in a
folders items collection and get the size of each item.

I understand what you are saying about the RPC limit so I have done
some further testing.

I have 627 items in the mailbox - 22 return an error with MAPI. I
wrote the item ID number for all items in the mailbox to MS Access
tables (one table for the MAPI procedure - 605 records, and one table
for the OOM procedure - 627 records). By querying one table against
the other I can get the ID for all the MAPI Items that fail from the
OOM table.

To do the test I closed Outlook (to make sure there was nothing
running in outlook that might be hogging resources) and wrote a short
procedure in MS Access to use the ID numbers collected to access each
item directly with minimal access to MAPI objects. The procedure is
as follows:

Function fnTestBrokenItems()
On Error Resume Next

Dim db As DAO.Database
Dim rsMAPI as DAO.Recordset

Dim mpSess As MAPI.Session
Dim obj As Object

Dim strEntryID As String
Dim lngError As Long
Dim lngOK As Long

Set db = CurrentDb
Set rsMAPI = db.OpenRecordset("qryTEST", dbOpenSnapshot)

Set mpSess = New MAPI.Session
mpSess.Logon "Outlook"

lngError = 0
lngOK = 0
With rsMAPI
If Not .EOF Then .MoveFirst
Do Until .EOF
strEntryID = !EntryID
Set obj = Nothing
Set obj = mpSess.GetMessage(strEntryID)
If TypeName(obj) = "Nothing" Then
lngError = lngError + 1
Else
lngOK = lngOK + 1
End If
.MoveNext
Loop
End With

Debug.Print lngError & " errors. " & vbCrLf & lngOK & " ok."

rsMAPI.Close
Set rsMAPI = Nothing
Set db = Nothing

Set obj = Nothing
mpSess.Logoff
Set mpSess = Nothing

End Function

I sorted the qryTEST recordset so that all the items causing error
were at the top. I still get 22 errors and 605 ok and they occur in
that order. That is, 22 errors occur THEN I get 605 items that read
ok. The 605 are read last so I would presume that its not hitting the
limit because the error items occur first (with the first assignment
of obj). I verified this by putting a break in the line lngOK = lngOK
+ 1 so the routine stopped the first time it hit a message that was ok
and the count for lngError was 22.

Interestingly, its only *MeetingItem* type items that are causing an
error. Would the problem be that MeetingItems cannot actually be
created but are the result of a response to an *AppointmentItem*?

I understand the question about cached or online but do not know how
to tell which one I am using. The example code I have provided is
exactly what I am running, how can I tell whether I am accessing
cached or the online store?

In any case, I ran a further tests where I copied the offending items
(and a number of ok items) into a PST file stored on my local drive
(to get around the cached or online problem). I get the same result.
That is, any item of *MeetingItem* type, MAPI does not seem to be able
to read at all. All others seem to read fine.

FYI, CDO.DLL VERSION = 6.5.6980.74.

Regards


Greg J

 

[Dmitry Streblechenko]

I'd rather use a MAPI table to retrieve the PR_MESSAGE_SIZE property for all
messages in the folder. This way your won't have to open any messages and it
will be an order of magnitude faster.
I don't know if Redemption an option for you, but the following script
should do the job for any given folder.

Set Folder = Application.ActiveExplorer.CurrentFolder

iSize = 0
dim Columns(0)
dim Row
set Table = CreateObject("Redemption.MAPITable")
Table.Item = Folder.Items
PR_MESSAGE_SIZE = &H0E080003
Columns(0) = PR_MESSAGE_SIZE
Table.Columns = Columns
Table.GoToFirst
do
Row = Table.GetRow
if Not IsEmpty(Row) Then
iSize = iSize + Row(0)
End If
Loop Until IsEmpty(Row)

MsgBox "The size of all messages in the folder is " & iSize & " bytes"

Dmitry Streblechenko (MVP)
http://www.dimastr.com/
OutlookSpy - Outlook, CDO
and MAPI Developer Tool