Script moves only a couple of 'Inbox' items on each execution - vba

Question

I have the follwing VBA script for Outlook that should move emails to the Archives folder (that are not categorized in one of the special categories). It both works and not. I mean it moves some emails but skips the others so I have to run it mulitple times until the Inbox is cleaned-up. I don't understand why it behaves this way. It doesn't throw any exceptions it just doesn't do its job for all items. Can you see anything suspicios here?
Option Explicit
Sub CleanUpInbox()
Dim ns As Outlook.NameSpace
Set ns = GetNamespace("MAPI")
Dim inbox As Outlook.Folder: Set inbox = ns.GetDefaultFolder(olFolderInbox)
Dim archive As Outlook.Folder: Set archive = ns.Folders("my#mailbox.abc").Folders("Archives").Folders("2018")
Dim maxDiffInDays As Integer: maxDiffInDays = 14
Dim today As Date: today = DateValue(now())
On Error GoTo bang
Dim mail As Variant ' Outlook.MailItem
For Each mail In inbox.Items
If mail Is Nothing Then
GoTo continue
End If
Dim receivedOn As Date: receivedOn = DateValue(mail.ReceivedTime)
Dim diff As Integer: diff = DateDiff("d", receivedOn, today)
Dim isOld As Boolean: isOld = True ' diff > maxDiffInDays
If isOld Then
'Debug.Print diff
'Debug.Print mail.Subject
'Debug.Print mail.Categories
Dim isPinned As Boolean: isPinned = InStr(mail.Categories, "PINNED")
Dim isTTYL As Boolean: isTTYL = InStr(mail.Categories, "TTYL")
If LinqAll(False, isPinned, isTTYL) Then
Debug.Print mail.Subject
mail.Move archive
End If
End If
GoTo continue
bang:
Debug.Print "bang!"
Debug.Print Err.Description
continue:
Next
End Sub
Function LinqAll(ByVal Expected As Boolean, ParamArray Values() As Variant) As Boolean
Dim x As Variant
For Each x In Values
If x <> Expected Then
LinqAll = False
Exit Function
End If
Next
LinqAll = True
End Function
Function LinqAny(ByVal Expected As Boolean, ParamArray Values() As Variant) As Boolean
Dim x As Variant
For Each x In Values
If x = Expected Then
LinqAny = True
Exit Function
End If
Next
LinqAny = False
End Function

Answer 1

Not sure whether I miss something here, but your code seems to handle any mail as old, for you set isOld to true within the loop. Is there a special reason for declaring isPinedand isTTYLeach loop? Have you tried:
Sub CleanUpInbox()
Dim ns As Outlook.Namespace
Dim inbox As Outlook.Folder: Set inbox = ns.GetDefaultFolder(olFolderInbox)
Dim archive As Outlook.Folder: Set archive = ns.Folders("my#mailbox.abc").Folders("Archives").Folders("2018")
Dim maxDiffInDays As Integer: maxDiffInDays = 14
Dim today As Date: today = DateValue(Now())
Dim mail As Variant ' Outlook.MailItem
Dim receivedOn As Date
Dim diff As Integer
Dim isOld As Boolean
Dim isPinned As Boolean
Dim isTTYL As Boolean
Set ns = GetNamespace("MAPI")
On Error GoTo bang
For Each mail In inbox.Items
If mail Is Nothing Then
GoTo continue
End If
isOld = False
receivedOn = DateValue(mail.ReceivedTime)
diff = DateDiff("d", receivedOn, today)
If diff > maxDiffInDays Then
isOld = True
End If
isPinned = InStr(mail.Categories, "PINNED")
isTTYL = InStr(mail.Categories, "TTYL")
If LinqAll(False, isPinned, isTTYL) Then
Debug.Print mail.Subject
mail.Move archive
End If
GoTo continue
bang:
Debug.Print "bang!"
Debug.Print Err.Description
continue:
Next
End Sub

Answer 2

I've solved it. You must not use Items in a For Each loop and at the samve time .Move its items. It's like modifying the loop collection in C#. The only difference is that C# is throwing a nice exception while VBA just reduces the number of items and then just stops :-o
Instead, I used Do While and two counters. One that counts the processed items and the other that is the current index for Items. Now it processes everything.
Sub CleanUpInbox2()
' ... other variables
Dim processCount As Integer
Dim itemIndex As Integer: itemIndex = 1
Dim itemCount As Integer: itemCount = inbox.Items.Count
Do While processCount < itemCount
processCount = processCount + 1
Set mail = inbox.Items(itemIndex)
' ... body
If LinqAll(False, isPinned, isTTYL) Then
Debug.Print mail.Subject
mail.Move archive
moveCount = moveCount + 1
Else
itemIndex = itemIndex + 1
End If
bang:
Debug.Print "bang!"
Debug.Print Err.Description
continue:
Loop
Debug.Print "Emails processed: " & processCount
Debug.Print "Emails moved: " & moveCount
End Sub
I tried to copy Items first but I didn't succeed with that (apparently there is no new Outlook.Items) so I use indexes.