Looping through inbox - object sets itself to nothing

[samuelimtech]

hi all,

I've written a script that loops through all the emails in my inbox and, if a folder exists that match the simle criteria it moves it there. for some strange reason after going through a few time the Email object becomes nothing and i cant work out why. Oddly enough if i wait a few seconds i can continue with the code (simply pressing f5.)





Private Sub loop_test()




Set objNS = GetNamespace("MAPI")
Set objinbox = objNS.GetDefaultFolder(olFolderInbox)
Set objFolder = objNS.GetDefaultFolder(olFolderInbox).Folders("Opportunities").Folders("Customers")

Dim currenttime As Date

For Each Email In objinbox.Items
For Each SubFolder In objFolder.Folders
If InStr(Email.subject, SubFolder.Name) Then

Email.Move SubFolder
End If


Next SubFolder
Next Email




End Sub




thanks for any help

[gmayor]

Try the following. You should loop backwards through the messages as shown or the process can lose track of the count when the messages are moved.


Public Sub loop_test()
Dim i As Long
Dim objNS As NameSpace
Dim objInbox As Folder
Dim objFolder As Folder
Dim subFolder As Folder
Dim olMail As MailItem

Set objNS = GetNamespace("MAPI")
Set objInbox = objNS.GetDefaultFolder(olFolderInbox)
Set objFolder = objNS.GetDefaultFolder(olFolderInbox).folders("Opportunities").folders("Customers")

For i = objInbox.items.Count To 1 Step -1
If TypeName(objInbox.items(i)) = "MailItem" Then
Set olMail = objInbox.items(i)
For Each subFolder In objFolder.folders
If InStr(olMail.Subject, subFolder.Name) Then
olMail.Move subFolder
Exit For
End If
DoEvents
Next subFolder
End If
DoEvents
Next i
Set objNS = Nothing
Set objInbox = Nothing
Set olMail = Nothing
Set objFolder = Nothing
Set subFolder = Nothing
End Sub

[samuelimtech]

Thanks Graham, that makes perfect sense and pretty obvious when you think about it.

thanks