code for outlook

I get a ton of spam each day and just delete it without reading any of it. So, my deleted items folder quickly becomes filled with spam. But there are also messages in there that I don't want to get rid of right away. I figure I may need them so I don't want to permanently delete them yet. But I do want to get all of the unread messages out of there. I wrote this code (some borrowed from the web) to clean out my deleted items folder. What's strange is that I have to run it 3 or 4 times for it to completely clean out my folder of unread items. Each pass through will clean out some unread items, but not all of them. Does anyone know why it wouldn't just do them all at one time? Thanks.

Code:

---

Dim wObj As Outlook.Application
Dim nsMAPI As Outlook.NameSpace
Dim mi As Object
Dim d As Long
Dim p As Long

Set wObj = createobject("Outlook.Application")
Set nsMAPI = wObj.GetNamespace("MAPI")
For d = 1 To nsMAPI.Folders.Count
  For p = 1 To nsMAPI.Folders.Count
  If nsMAPI.Folders.Item(d).Folders.Item(p).Name = "Deleted Items" Then
    nsMAPI.Folders.Item(d).Folders.Item(p).Display
    For Each mi In nsMAPI.Folders.Item(d).Folders.Item(p).Items
      If mi.Class = olMail Then
        If mi.UnRead = True Then
          mi.Delete
        End If
      End If
    Next
    Exit Sub
  End If
  Next p
Next d
Set wObj = Nothing

---

You are counting up through the folder, and deleting things as you go. This reduces the numbers in the folder, so the next iteration misses a message. Try counting down instead.

For d = 1 To nsMAPI.Folders.Count

change to:

For d = nsMAPI.Folders.Count to 1 step -1

No, that gave me the same results.

I reckon JordanChris is right.

Try putting

d =-1
p =-1

one or the other or both after

mi.Delete

That might stop it skipping one.

If we're not right then see which it missing deleting and look in the is some kind of sequence (eg. it might miss every 3rd item) and they you know its problem something to do with your loops.

By the way should that exit sub be where it is?