Almost there, last received email not being processed

[DuncanW]

Sorry I forgot to use the VBA tags last time!
So I have made progress and most of my issues in my last post I have corrected. The code that is below is messy (I will clean it up when I get working its been pieced together from examples I have seen), and I'm sorry for any pros who are looking at it and crying :). This code accomplishes what I need:

1) new mail is received
2) adds addresses to contacts if it doesnt exist, based on email
3) move email to specified folder
4) auto reply

This is all going smoothly, EXCEPT, when more than one email is received at a time, the last received email is missed. It stays in my inbox and is unread.

I have read, and read, and read, and I cant figure out why that one email is being missed. I have read that a NewMailEx and ItemAdd can miss things, but its consistent, always the last email received, which leads me to believe its more of a problem with my code. I'm still a noobie and ANY help here would be great.

I would set a timer, or use tasks on a timer, but for my use, triggering on a new mail is ideal.

My last post had no replies, I figured it out, but a reply here would be great, suggestions, ideas, or a point in the right direction!

For Outlook 2000

VBA:

Private WithEvents Items As Outlook.Items
Private Sub Application_Startup()
Dim olApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Set olApp = Outlook.Application
Set objNS = olApp.GetNamespace("MAPI")
' default local Inbox
Set Items = objNS.GetDefaultFolder(olFolderInbox).Items
End Sub

Private Sub Items_ItemAdd(ByVal item As Object)
On Error GoTo ErrorHandler
Dim msg As Outlook.MailItem

If TypeName(item) = "MailItem" Then
Set msg = item
'MsgBox ("New Join!")
' MsgBox msg.Subject
Call AddAddressesToContactsAuto
' Call find_unread '''''ADD THIS BACK
' MsgBox msg.Body
' test field
' Dim oout As Object
' Dim omsg As Object

' Set oout = CreateObject("Outlook.Application")
' Set omsg = oout.CreateItem(0)

' With omsg
' .To = msg.Subject
' .CC = ""
' .BCC = ""
' .Subject = Thanks
' .Body = (msg.Body & "Thank you for joining Club PFM! You will be receiving your first newsletter with your special Club PFM offer within the next 7 days!")
' .Display
' End With

' testing
' If omsg.Sent Then
' MsgBox (" Sent ")
' Else
' MsgBox (" Not Send ! ")
' End If

' Set oout = Nothing
' Set omsg = Nothing

' end test field
End If
ProgramExit:
Exit Sub
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ProgramExit
End Sub

Public Sub AddAddressesToContactsAuto()
Dim folContacts As Outlook.MAPIFolder
Dim folContacts2 As Outlook.MAPIFolder
Dim folContacts3 As Outlook.MAPIFolder
Dim colItems As Outlook.Items
Dim colItems2 As Outlook.Items
Dim colItems3 As Outlook.Items
Dim oContact As Outlook.ContactItem
Dim oContact2 As Outlook.ContactItem
Dim oContact3 As Outlook.ContactItem
Dim oMail As Outlook.MailItem
Dim obj As Object
Dim oNS As Outlook.NameSpace
Dim folder As MAPIFolder
Dim myDestFolder As Outlook.MAPIFolder


Dim response As VbMsgBoxResult

Dim bContinue As Boolean

Dim sSenderName As String
Dim emailz As String

On Error Resume Next

Set oNS = Application.GetNamespace("MAPI")
Set folContacts = oNS.GetDefaultFolder(olFolderContacts)
Set folContacts2 = oNS.GetDefaultFolder(olFolderContacts).Folders("Awaiting Invitation")
Set folContacts3 = oNS.GetDefaultFolder(olFolderContacts).Folders("Added To Mail List")
Set colItems = folContacts.Items
Set colItems2 = folContacts2.Items
Set colItems3 = folContacts3.Items
Set folder = oNS.GetDefaultFolder(olFolderInbox) '.Folders("Awaiting Invitation")
Set myDestFolder = oNS.GetDefaultFolder(olFolderInbox).Folders("Awaiting Invitation")

For Each obj In folder.Items

If (obj.Class = olMail) And (obj.UnRead) Then

Set oContact = Nothing
Set oContact2 = Nothing
Set oContact3 = Nothing

bContinue = True
sSenderName = ";"

Set oMail = obj

sSenderName = oMail.Body
emailz = oMail.Subject
If sSenderName = ";" Then
sSenderName = oMail.Body
emailz = oMail.Subject
End If

Set oContact = colItems.Find("[E-mail] = '" & emailz & "'")
Set oContact2 = colItems2.Find("[E-mail] = '" & emailz & "'")
Set oContact3 = colItems3.Find("[E-mail] = '" & emailz & "'")

'start checks
'default folder
If Not (oContact Is Nothing) Then

response = MsgBox(emailz & " Already exists in contacts! Add anyways?", vbQuestion + vbYesNo, "Contact Adder")
If response = vbNo Then
bContinue = False
End If
End If
'awaiting invitation
If Not (oContact2 Is Nothing) Then

response = MsgBox(emailz & " Already exists in contacts! Add anyways?", vbQuestion + vbYesNo, "Contact Adder")
If response = vbNo Then
bContinue = False
End If
End If
'added to mail list
If Not (oContact3 Is Nothing) Then

response = MsgBox(emailz & " Already exists in contacts! Add anyways?", vbQuestion + vbYesNo, "Contact Adder")
If response = vbNo Then
bContinue = False
End If
End If

'end checks
If bContinue = True Then
oMail.Move myDestFolder 'ADDED THIS REMOVE IF YOU BREAK IT!!!
Set oContact = colItems2.Add(olContactItem)
With oContact
.Body = "Club PFM Member!"
.Email1Address = emailz
.BusinessAddress = emailz
.FullName = sSenderName
.Save
End With
'testing start
'testing end
End If
End If
emailz = ""
Next


Set folContacts = Nothing
Set folContacts2 = Nothing
Set folContacts3 = Nothing
Set colItems = Nothing
Set colItems2 = Nothing
Set colItems3 = Nothing
Set oContact = Nothing
Set oContact2 = Nothing
Set oContact3 = Nothing
Set oMail = Nothing
Set obj = Nothing
Set oNS = Nothing
Call find_unread

End Sub

Sub find_unread()
On Error GoTo eh:
' I want to be able to catch up by reading all my unread messages
Dim ns As Outlook.NameSpace
Dim folder As MAPIFolder
Dim item As Object
Dim msg As MailItem
'for sending mail
Dim oout As Object
Dim omsg As Object
'end sending mail
Dim Thanks As String
' Open the inbox folder
Set ns = Session.Application.GetNamespace("MAPI")
Set folder = ns.GetDefaultFolder(olFolderInbox).Folders("Awaiting Invitation")

' Loop through items in the inbox folder
For Each item In folder.Items
DoEvents
If (item.Class = olMail) And (item.UnRead) Then
' This message has not been read. Display it modally
Set msg = item
item.UnRead False
Thanks = ("Thanks for joining Club PFM!")
MsgBox ("7 Day notice sent to: " & msg.Subject)
'create auto response
Set oout = CreateObject("Outlook.Application")
Set omsg = oout.CreateItem(0)

With omsg
.To = msg.Subject
.CC = ""
.BCC = ""
.Subject = Thanks
.Body = (msg.Body + "Thank you for joining Club PFM! You will be receiving your first newsletter with your special Club PFM offer within the next 7 days!")
.Display
End With
'end response
'try calling other operations, see if they work!!
'does not work in this fashion, try putting entire code here, then call this on new mail event

'Call AddAddressesToContacts
'end calling operations
' uncomment the next line to have it only find one unread
' message at a time
'Exit For
End If
Next

' If you uncommented the line to read individual messages,
' comment the next line so you don't get a message box
' every single message!

MsgBox "All messages in Inbox are read", vbInformation, "All Read"
Exit Sub
eh:
MsgBox Err.Description, vbCritical, Err.Number
End Sub

[skatonni]

The problem is surely here
oMail.Move myDestFolder

When changing the number of items do not use For Each.

Rather than
For Each obj In folder.Items

Count backwards
For i = folder.Items.Count To 1 Step -1
Set obj = folder.Items(i)

[DuncanW]

What is the problem with:

oMail.Move myDestFolder

I will try your method and let you know if it works! Thanks for the reply! :)

[skatonni]

What is the problem with:

oMail.Move myDestFolder

I will try your method and let you know if it works! Thanks for the reply! :)

It doesn't look like it but there is an index underneath that you are changing unpredictably when you move or delete from a collection with a For Each.

This has probably tripped up 99.9% of all programmers at least once.

[DuncanW]

Ok so if I comment out "Call find_unread" AddAddressesToContactsAuto triggers when it should, and handles all emails without missing any! Thank you for the tip! It seems find_unread is flawed...I've used, your method, and "For Each" and either way, emails are missed. It will stop AddAddressesToContactsAuto from completing as well! Not sure why, If I call find_unread at the end of AddAddressesToContactsAuto why would it prevent it from completing? and if it gets called, using both methods, emails are still missed. Should I have a listener on the "Awaiting Invitations" folder and have find_unread trigger on unread messages in there? or am I overlooking something?

Thanks,
Duncan

[DuncanW]

Sorry here's the relevant updated code: It still misses the last received email for some reason. If I comment out "Call find_unread" from the end of "AddAddressesToContactsAuto" it catches all emails and AddAddressesToContactsAuto works fine, otherwise, with what I have, last received email is missed. It stays in my inbox and stays unread, again, not sure why calling that would interfere with where its being called from!


Sub find_unread()
On Error GoTo eh:
' I want to be able to catch up by reading all my unread messages
Dim ns As Outlook.NameSpace
Dim folder As MAPIFolder
Dim item As Object
Dim msg As MailItem
'for sending mail
Dim oout As Object
Dim omsg As Object
Dim obj As Object
'end sending mail
Dim Thanks As String
' Open the inbox folder
Set ns = Session.Application.GetNamespace("MAPI")
Set folder = ns.GetDefaultFolder(olFolderInbox).Folders("Awaiting Invitation")

' Loop through items in the inbox folder
'For Each item In folder.Items
For I = folder.Items.Count To 1 Step -1
Set obj = folder.Items(I)
DoEvents
If (obj.Class = olMail) And (obj.UnRead) Then
' This message has not been read. Display it modally
Set msg = obj
obj.UnRead False
Thanks = ("Thanks for joining Club PFM!")
MsgBox ("7 Day notice sent to: " & msg.Subject)
'create auto response
Set oout = CreateObject("Outlook.Application")
Set omsg = oout.CreateItem(0)

With omsg
.To = msg.Subject
.CC = ""
.BCC = ""
.Subject = Thanks
.Body = (msg.Body + "Thank you for joining Club PFM! You will be receiving your first newsletter with your special Club PFM offer within the next 7 days!")
.Display
End With
'end response
'try calling other operations, see if they work!!
'does not work in this fashion, try putting entire code here, then call this on new mail event

'Call AddAddressesToContacts
'end calling operations
' uncomment the next line to have it only find one unread
' message at a time
'Exit For
End If
Next

' If you uncommented the line to read individual messages,
' comment the next line so you don't get a message box
' every single message!

MsgBox "All messages in Inbox are read", vbInformation, "All Read"
Exit Sub
eh:
MsgBox Err.Description, vbCritical, Err.Number
End Sub

Public Sub AddAddressesToContactsAuto()
Dim folContacts As Outlook.MAPIFolder
Dim folContacts2 As Outlook.MAPIFolder
Dim folContacts3 As Outlook.MAPIFolder
Dim colItems As Outlook.Items
Dim colItems2 As Outlook.Items
Dim colItems3 As Outlook.Items
Dim oContact As Outlook.ContactItem
Dim oContact2 As Outlook.ContactItem
Dim oContact3 As Outlook.ContactItem
Dim oMail As Outlook.MailItem
Dim obj As Object
Dim oNS As Outlook.NameSpace
Dim folder As MAPIFolder
Dim myDestFolder As Outlook.MAPIFolder


Dim response As VbMsgBoxResult

Dim bContinue As Boolean

Dim sSenderName As String
Dim emailz As String

On Error Resume Next

Set oNS = Application.GetNamespace("MAPI")
Set folContacts = oNS.GetDefaultFolder(olFolderContacts)
Set folContacts2 = oNS.GetDefaultFolder(olFolderContacts).Folders("Awaiting Invitation")
Set folContacts3 = oNS.GetDefaultFolder(olFolderContacts).Folders("Added To Mail List")
Set colItems = folContacts.Items
Set colItems2 = folContacts2.Items
Set colItems3 = folContacts3.Items
Set folder = oNS.GetDefaultFolder(olFolderInbox) '.Folders("Awaiting Invitation")
Set myDestFolder = oNS.GetDefaultFolder(olFolderInbox).Folders("Awaiting Invitation")

'For Each obj In folder.Items
For I = folder.Items.Count To 1 Step -1
Set obj = folder.Items(I)
If (obj.Class = olMail) And (obj.UnRead) Then

Set oContact = Nothing
Set oContact2 = Nothing
Set oContact3 = Nothing

bContinue = True
sSenderName = ";"

Set oMail = obj

sSenderName = oMail.Body
emailz = oMail.Subject
If sSenderName = ";" Then
sSenderName = oMail.Body
emailz = oMail.Subject
End If

Set oContact = colItems.Find("[E-mail] = '" & emailz & "'")
Set oContact2 = colItems2.Find("[E-mail] = '" & emailz & "'")
Set oContact3 = colItems3.Find("[E-mail] = '" & emailz & "'")

'start checks
'default folder
If Not (oContact Is Nothing) Then

response = MsgBox(emailz & " Already exists in contacts! Add anyways?", vbQuestion + vbYesNo, "Contact Adder")
If response = vbNo Then
bContinue = False
End If
End If
'awaiting invitation
If Not (oContact2 Is Nothing) Then

response = MsgBox(emailz & " Already exists in contacts! Add anyways?", vbQuestion + vbYesNo, "Contact Adder")
If response = vbNo Then
bContinue = False
End If
End If
'added to mail list
If Not (oContact3 Is Nothing) Then

response = MsgBox(emailz & " Already exists in contacts! Add anyways?", vbQuestion + vbYesNo, "Contact Adder")
If response = vbNo Then
bContinue = False
End If
End If

'end checks
If bContinue = True Then
obj.Move myDestFolder 'ADDED THIS REMOVE IF YOU BREAK IT!!!
Set oContact = colItems2.Add(olContactItem)
With oContact
.Body = "Club PFM Member!"
.Email1Address = emailz
.BusinessAddress = emailz
.FullName = sSenderName
.Save
End With
'testing start
'testing end
End If
End If
emailz = ""
Next


Set folContacts = Nothing
Set folContacts2 = Nothing
Set folContacts3 = Nothing
Set colItems = Nothing
Set colItems2 = Nothing
Set colItems3 = Nothing
Set oContact = Nothing
Set oContact2 = Nothing
Set oContact3 = Nothing
Set oMail = Nothing
Set obj = Nothing
Set oNS = Nothing
Call find_unread

End Sub

[DuncanW]

Ok guys, So I've done some testing, taking suggestions into account. I created a new function for the moving folders process and made that seperate. I tested that along with AddAddressesToContactsAuto, and find_unread manually and they all work just fine! I guess the problem lies in when scripts are being called...I think they wind up running simultaneously which is what is messing it up. How should I call them? I have AddAddressesToContactsAuto calling find_unread which then calls the moving folder function, but the end up overlapping, how do I prevent this? or what is the proper method for calling events you want to trigger one after another?

[skatonni]

I finally saw that there is a loop in both AddAddressesToContacts and find_unread.

Remove the loop from AddAddressesToContacts and pass the specific mailitem you wish to process.

Public Sub AddAddressesToContactsAuto(obj as Mailitem)

then in Item_Add and find_unread
AddAddressesToContacts obj