R
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
Logicwurks, LLC
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
Logicwurks, LLC