vba problems when deleting Outlook mail items

[melodramatic]

I have a macro that goes through a specified mail folder (where I receive notification of new projects), pulls information from it for my data table, and then deletes that email before going on to the next. Or at least that's what it's supposed to do.

At this point, I have 22 new project emails in my "SPACE" email folder. Everything was working find until I added in the delete email code. At that point, the macro went and listed 11 emails, sent those to the deleted items, and completely ignored the other half of the emails. If I run it a second time, it will get 6 of the remaining 11, and so on.

Can anyone figure out what I've done wrong in coding that adding that one simple line screws it all up? Thank you in advance for you assist on this!

Sub NewProjects()
Dim olApp As Outlook.Application
Dim olNamespace As Namespace
Dim olFolder As MAPIFolder
Dim olMail As Variant
Dim countMail As Integer
Dim nextrow As Long
Set olApp = New Outlook.Application
Set olNamespace = olApp.GetNamespace("MAPI")
Set olFolder = olNamespace.GetDefaultFolder(olFolderInbox)
Set olFolder = olFolder.Folders("SPACE")
countMail = 0
For Each olMail In olFolder.Items
        nextrow = Range("B1")

Range("A" & nextrow).Value = olMail.ReceivedTime
Range("B" & nextrow).Value = olMail.Body
olMail.Delete 'THIS IS THE OFFENDING LINE

Range("B" & nextrow).Select
With Selection
.WrapText = False
End With
Rows(nextrow & ":" & nextrow).EntireRow.AutoFit

    countMail = countMail + 1
Next olMail
Set olFolder = Nothing
Set olSub = Nothing
Set olNamespace = Nothing
Set olApp = Nothing
MsgBox countMail & " New Projects have been received"
End Sub

 

[mrshl9898]

Try this:

You're looking at the first item, deleting it, making the second item now the first, then going to the second item which was teh third etc..

Sub NewProjects()
Dim olApp As Outlook.Application
Dim olNamespace As Namespace
Dim olFolder As MAPIFolder
Dim olMail As Object
Dim countMail As Integer
Dim nextrow As Long
Set olApp = New Outlook.Application
Set olNamespace = olApp.GetNamespace("MAPI")
Set olFolder = olNamespace.GetDefaultFolder(olFolderInbox)
Set olFolder = olFolder.Folders("special costs")
Set Delete_Items = olFolder.Items

countMail = 0
For Each olMail In olFolder.Items
        nextrow = Range("B1")

Range("A" & nextrow).Value = olMail.ReceivedTime
Range("B" & nextrow).Value = olMail.Body

Range("B" & nextrow).Select
With Selection
.WrapText = False
End With
Rows(nextrow & ":" & nextrow).EntireRow.AutoFit

    countMail = countMail + 1
Next olMail

For i = Delete_Items.Count To 1 Step -1
    Delete_Items.Item(i).Delete
Next



Set olFolder = Nothing
Set olSub = Nothing
Set olNamespace = Nothing
Set olApp = Nothing
MsgBox countMail & " New Projects have been received"
End Sub

 

[melodramatic]

Adding that For I = Delete... section did the job perfectly. Thank you so much!