Access Program Only Looping Part Way Through Outlook Inbox

[Rich Locus]

Hello Outlook Group:

I am developing an Access application that reads through the Inbox (both
read and unread mail), and under certain conditions, adds the mail
information to an Access database. When I am done looking at the mail item,
I file it one one of two folders: either REJECTS or SAVED MAIL. I'm using
POP3.

The problem is that it only loops about half-way through the inbox and exits
BEFORE all the mail in the inbox folder is processed. I have two sub-folders
under the inbox, one call REJECTS and the other SAVED MAIL.

If I do a ? InboxItems.COUNT, the count of the mail is correct... i.e. it
will say I have 7 emails, and that's the correct number, but it only loops
through about 4 times instead of 7 and leaves mail in the INBOX. The code
follows. Any ideas?

Option Compare Database
Option Explicit

Public Function ReadInboxAndMoveV1()
Dim TempRst As DAO.Recordset
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 db As DAO.Database

DoCmd.SetWarnings False
DoCmd.RunSQL "Delete * from tbl_outlooktemp"
DoCmd.SetWarnings True
Set db = CurrentDb

Set OlApp = CreateObject("Outlook.Application")
Set Inbox = OlApp.GetNamespace("Mapi").GetDefaultFolder(olFolderInbox)
Set SavedMailFolder =
OlApp.GetNamespace("Mapi").GetDefaultFolder(olFolderInbox).Folders("Saved
Mail")
Set RejectMailFolder =
OlApp.GetNamespace("Mapi").GetDefaultFolder(olFolderInbox).Folders("Rejects")
Set TempRst = CurrentDb.OpenRecordset("tbl_OutlookTemp")
'
Set InboxItems = Inbox.Items
'
For Each Mailobject In InboxItems
If UCase(Left(Mailobject.Subject, 6)) <> "CLIENT" Then
Mailobject.UnRead = False
Set SavedMailItems = Mailobject.Move(RejectMailFolder)
Else
With TempRst
.AddNew
!Subject = Mailobject.Subject
!from = Mailobject.SenderName
!To = Mailobject.To
!Body = Mailobject.Body
!DateSent = Mailobject.SentOn
.Update
Mailobject.UnRead = False
Set SavedMailItems = Mailobject.Move(SavedMailFolder)
End With
End If
Next

Set TempRst = Nothing
Set OlApp = Nothing
Set Inbox = Nothing
Set SavedMailFolder = Nothing
Set InboxItems = Nothing
Set SavedMailItems = Nothing
Set Mailobject = Nothing

End Function

Any help would be appreciated!!!

 

[Rich Locus]

One more fact. If I keep running the Access macro that runs the code listed
above, eventually all the mail gets processed. It's just a mystery why it
quits early. For example, if I have 10 emails in my Inbox, it might clear
out 6 and leave 4 in the INBOX. The next time I run it, it might process 3
of the 4 and leave 1. Then the third time I run it, it will finally clear
out the email. VERY STRANGE!!!

 

[Rich Locus]

Moderator:
Could you please delete this post? I'm going to put in a simpler example.