Proof Of Looping Bug in Reading Outlook Inbox From Access?

[Rich Locus]

Outlook Group:
Here is a simple program run from Microsoft Access that loops through the
Outlook Inbox and moves the mail from the Inbox to one of two folders: "Saved
Mail" or "Rejects". These are user folders at the same level as all the
other standard folders.. (i.e. they are not underneath any of the standard
folders).

Each time it is run, it only moves one half of the items in the inbox.

So, if there are 20 mails in the Inbox, and I run the program, it only moves
10 items to the user folders and leaves 10 still in the Inbox.
If I run it a second time, then the inbox goes from 10 to 5.
When I run it a third time, the inbox goes to 3.
Next time, to 1.
And finally all the mail is moved.

It divides it in half each time.

Unless I'm missing something, this bug is related to the fact that I'm
moving items to a different folder. The bug DOES NOT OCCUR if I don't move
the mail to another folder.

Here's the code. Any comments would be appreciated.

Option Compare Database
Option Explicit

Public Function IllustrateLoopBug()
Dim OlApp As Outlook.Application
Dim Inbox As Outlook.MAPIFolder
Dim SavedMailFolder As Outlook.MAPIFolder
Dim RejectMailFolder As Outlook.MAPIFolder
Dim InboxItems As Outlook.Items
Dim SavedMailItems As Outlook.MailItem
Dim RejectMailItems As Outlook.MailItem
Dim Mailobject As Object

Dim intMailItems As Integer
Dim intCountedLoops As Integer

intCountedLoops = 0

Set OlApp = CreateObject("Outlook.Application")
Set Inbox = OlApp.GetNamespace("Mapi").GetDefaultFolder(olFolderInbox)
Set SavedMailFolder =
OlApp.GetNamespace("Mapi").GetDefaultFolder(olFolderInbox).Parent.Folders("Saved Mail")
Set RejectMailFolder =
OlApp.GetNamespace("Mapi").GetDefaultFolder(olFolderInbox).Parent.Folders("Rejects")

Set InboxItems = Inbox.Items
intMailItems = InboxItems.Count
intCountedLoops = 0

For Each Mailobject In InboxItems
intCountedLoops = intCountedLoops + 1
If UCase(Left(Mailobject.Subject, 6)) <> "CLIENT" Then
Mailobject.UnRead = False
Set SavedMailItems = Mailobject.Move(RejectMailFolder)
Else
Mailobject.UnRead = False
Set SavedMailItems = Mailobject.Move(SavedMailFolder)
End If
Next

If intMailItems <> intCountedLoops Then
MsgBox ("Mail Items = " & intMailItems & ", Counted Loops = " &
intCountedLoops)
End If

Set OlApp = Nothing
Set Inbox = Nothing
Set SavedMailFolder = Nothing
Set RejectMailFolder = Nothing
Set InboxItems = Nothing
Set SavedMailItems = Nothing
Set RejectMailItems = Nothing
Set Mailobject = Nothing

End Function

 

[Karl Timmermans]

You may want to change your For Loop to the following construct so that you
work from the bottom up

"For i = InboxItems.Count to 1 step -1"
*** adjust everything in the body of the loop to use the index or
add "Set MailObject = InboxItems(i)" at the top of the loop

A "move" in essenece is a (copy/delete) - ergo, item is deleted from
InboxItems immediately after the item is copied to the target destination.

Karl
--
____________________________________________________________
Karl Timmermans - The Claxton Group
ContactGenie - QuickPort/DataPort/Exporter/Toolkit/Duplicate Contact Mgr
"Contact import/export/data management tools for Outlook '2000/2010"
http://www.contactgenie.com

 

[Rich Locus]

Karl:

Your solution was EXCELLENT!! I have included your suggestions in my code,
and for the benefit of others, posted the final working code.

This code handles the following requirements:
1) Read through the Outlook Inbox from another program such as Microsoft
Access
2) Process each email and MOVE it to another folder (essentially deleting it
from the Inbox)

If you start processing mail messages at the top of the Inbox (The pointer
will be 1 --- which is the standard in most Posts on the Internet), the move
of each email message to another folder causes its deletion from the Inbox,
and Outlook pushes all the other emails "up the stack". A loop that starts
with 1 and moves to the end will skip half the email because, for example,
let's say you are moving mail item 2 and your pointer is currently at 2, then
mail item 2 is deleted from the Inbox, and mail item 3 in the Inbox now
becomes mail item 2 after the move, but your pointer now moves to mail item
3, essentially skipping the processing of mail item 3 that moved to the
number 2 spot. In this manner, you will only process 1/2 of the Inbox items.

The key to making this work, as suggested by Karl Timmermans, is to start at
the END and move to the beginning. Starting at the end prevents the "up the
stack" movement, and keeps everything in sync. Since you are always deleting
from the end of the stack, items are not moved up the stack -- which prevents
the issue from happening.

Here's the code:

Option Compare Database
Option Explicit

Public Function IllustrateLoopWithDeletes()
Dim OlApp As Outlook.Application
Dim Inbox As Outlook.MAPIFolder
Dim SavedMailFolder As Outlook.MAPIFolder
Dim RejectMailFolder As Outlook.MAPIFolder
Dim InboxItems As Outlook.Items
Dim SavedMailItems As Outlook.MailItem
Dim RejectMailItems As Outlook.MailItem
Dim Mailobject As Object
Dim i As Integer

' *****************************************************************
' Before Running This, Create Two Folders At The Same Level
' As the Inbox - "Saved Mail" and "Rejects"
' *****************************************************************

Dim intMailItems As Integer 'Only Necessary For Logic Check
Dim intCountedLoops As Integer 'Only Necessary For Logic Check

Set OlApp = CreateObject("Outlook.Application")
Set Inbox = OlApp.GetNamespace("Mapi").GetDefaultFolder(olFolderInbox)
Set SavedMailFolder =
OlApp.GetNamespace("Mapi").GetDefaultFolder(olFolderInbox).Parent.Folders("Saved Mail")
Set RejectMailFolder =
OlApp.GetNamespace("Mapi").GetDefaultFolder(olFolderInbox).Parent.Folders("Rejects")
Set InboxItems = Inbox.Items

intMailItems = InboxItems.Count 'Initialize Logic Check Variable
intCountedLoops = 0 'Initialize Logic Check Variable

' *****************************************************************
' Counting Backwards is Necessary Because of Moves to Other Folders
' *****************************************************************
For i = InboxItems.Count To 1 Step -1
Set Mailobject = InboxItems(i)
intCountedLoops = intCountedLoops + 1
If UCase(Left(Mailobject.Subject, 6)) <> "CLIENT" Then
Mailobject.UnRead = False
Set SavedMailItems = Mailobject.Move(RejectMailFolder)
Else
Mailobject.UnRead = False
Set SavedMailItems = Mailobject.Move(SavedMailFolder)
End If
Next

If intMailItems <> intCountedLoops Then
MsgBox ("Mail Items = " & intMailItems & ", Counted Loops = " &
intCountedLoops)
End If

Set OlApp = Nothing
Set Inbox = Nothing
Set SavedMailFolder = Nothing
Set RejectMailFolder = Nothing
Set InboxItems = Nothing
Set SavedMailItems = Nothing
Set RejectMailItems = Nothing
Set Mailobject = Nothing

End Function