ItemAdd on Imap Folder get endless loop after saving item

Status
Not open for further replies.

Alex S.

New Member
Outlook version
Outlook 2007
Email Account
IMAP
Hi there

i have a little sub wich check and change the subject.
When it save the subject the ItemAdd Event is firing again and i get an endless loop.
Any ideas what is wrong?

Code:
Private Sub yFld_ItemAdd(ByVal item As Object) 
    If Left(item.Subject, 16) Like "Visit from Mail:" And IsNumeric(Mid(item.Subject, 17)) Then 
        NewSubject = "checked: " & item.Subject & " " & newVisit(CLng(Mid(item.Subject, 17))) 
        If item.Subject <> NewSubject Then 
            item.Subject = NewSubject 
            item.Save 
        End If 
    End If 
End Sub
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
It's an itemadd sub, so it fires when something is added... or saved. All affected messages have checked: as the first word in the subject? Try this instead: If left(lcase(item.Subject), 8) <> "checked:" Then

I'm not sure why it's failing on the item .subject test in the first line the second time around - I'm pretty sure it's failing on the numeric part in the second If.

This should also work in the second if
If Left(item.Subject, 16) Like "Visit from Mail:" then
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
For what it's worth, I tested your macro the best I could (since I don't have the newVisit function) and this works fine, it stops on the item.subject <> newsubject check, as it should. The problem could be with the newVisit function.
Dim NewSubject As String
If Left(item.Subject, 16) Like "Visit from Mail:" And IsNumeric(Mid(item.Subject, 17)) Then
NewSubject = "checked: " & item.Subject & " " & (CLng(Mid(item.Subject, 17)))
If item.Subject <> NewSubject Then
 

Alex S.

New Member
Outlook version
Outlook 2007
Email Account
IMAP
Hello Diane,
i think the check routine could be everything like len(subject)>1 for testing

You say the in your first post the ItemAdd Event is firing when an item is added/saved.
So in my case i can not change and save an item.sibject without a new ItemAdd Event?
 

Alex S.

New Member
Outlook version
Outlook 2007
Email Account
IMAP
Let me ask in other words
Why do i see after the edit and save of the item subject a new Mail Item with the changed subject and the "old" MailItem as deleted?
I would expect that the mail is just updated in the subject.

But in reality it makes a copy of the incomming mail with the changed Subject, saves this copy and deletes the original mail.
Has this something to do with the Imap folder?
 

Alex S.

New Member
Outlook version
Outlook 2007
Email Account
IMAP
Ok, i've got it fixed.
A little bit complicated but "only results count"
I just use a second Folder on my "normal" Inbox to do the changes, so on ItemAdd on the imap folder i only move the mail to my second folder, makes the changes and the move it back to the imap inbox

Code:
Private Sub yFld_ItemAdd(ByVal item As Object) 
    If Left(item.Subject, 16) Like "Visit from Mail:" And IsNumeric(Mid(item.Subject, 17)) Then 
        Debug.Print Now & "  -> " & item.Subject 
        x = "checked: " & item.Subject & " " & newVisit(CLng(Mid(item.Subject, 17))) 
        If item.Subject <> x Then 
            Dim oFld As Outlook.MAPIFolder 
            Set oFld = GetFolder("persönliche ordner\posteingang\visit") 
            item.Move oFld 
        End If 
    End If 
End Sub 
Private Sub vFld_ItemAdd(ByVal item As Object) 
    If Left(item.Subject, 16) Like "Visit from Mail:" And IsNumeric(Mid(item.Subject, 17)) Then 
        x = "checked: " & item.Subject & " " & newVisit(CLng(Mid(item.Subject, 17))) 
        Debug.Print Now & "  -> " & x 
        If item.Subject <> x Then 
            item.Subject = x 
            item.Save 
            Dim oFld As Outlook.MAPIFolder 
            Set oFld = GetFolder("info@xxxxxxu\posteingang") 
            item.Move oFld 
        End If 
    End If 
End Sub
NewVisit is a function which is searching in a database and give back some information

The GetFolder Function i use from Sue Mosher
Code:
Public Function GetFolder(strFolderPath As String) As Outlook.MAPIFolder 
' 
'  Sue Mosher 
' 
Dim objNS As Outlook.NameSpace 
Dim colFolders As Outlook.Folders 
Dim objFolder As Outlook.MAPIFolder 
Dim arrFolders() As String 
Dim i As Long 
On Error Resume Next 
 
arrFolders() = Split(strFolderPath, "\") 
Set objNS = Application.Session 
Set objFolder = objNS.Folders.item(arrFolders(0)) 
If Not objFolder Is Nothing Then 
    For i = 1 To UBound(arrFolders) 
        Set colFolders = objFolder.Folders 
        Set objFolder = Nothing 
        Set objFolder = colFolders.item(arrFolders(i)) 
        If objFolder Is Nothing Then 
            Exit For 
        End If 
    Next 
End If 
 
Set GetFolder = objFolder 
Set colFolders = Nothing 
Set objNS = Nothing 
End Function
i hope this help others who are looking for a solution

Best Alex
 
Status
Not open for further replies.
Top