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

Rich Locus

Logicwurks, LLC

 

[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

______________________

ContactGenie - QuickPort/DataPort/Exporter/Toolkit/Duplicate Contact Mgr

"""

"Rich Locus" <RichLocus> wrote in message

news:E22AA5BB-67BD-4C17-8583-49FB8BC9F9C7@microsoft.com...
> 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

> > Rich Locus
> Logicwurks, LLC

 

[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

Rich Locus

Logicwurks, LLC

"Karl Timmermans" wrote:


> 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
> > ______________________
>

> ContactGenie - QuickPort/DataPort/Exporter/Toolkit/Duplicate Contact Mgr
> """
>

> "Rich Locus" <RichLocus> wrote in message
> news:E22AA5BB-67BD-4C17-8583-49FB8BC9F9C7@microsoft.com...
> > 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
> > > > Rich Locus
> > Logicwurks, LLC

> .
>