Move ALL deleted items to folder (almost done)

[Lalaland]

Hi All,

I am trying to move ALL my Deleted Items to a archive folder called "Large Personal Folders/Deleted Items" and have the following code. The problem is when i select the macro, it only deletes like a few at a time. Can anybody please check and see if you can help? :help

Sub MoveDeletedItems()
'Move messages from Exchange mailbox folder "Deleted Items" to "Deleted Items Archive" personal folder's "Deleted Items" folder.
'Dim and Set
Dim objFolder As Outlook.MAPIFolder
Set objFolder = Outlook.Application.GetNamespace("MAPI").Folders("Large Personal Folders").Folders("Deleted Items")
Dim objTrash As Outlook.Items
Set objTrash = Outlook.Application.Session.GetDefaultFolder(olFolderDeletedItems).Items
Dim objItem As Object
'End Dim and Set
'Move Items
For Each objItem In objTrash
If objItem.Class = olMail Then
objItem.Move objFolder
End If
Next
'End Move Items
'Cleanup
Set objItem = Nothing
Set objFolder = Nothing
Set objInbox = Nothing
Set objNS = Nothing
'End Cleanup
End Sub

[Lalaland]

What i have noticed this code doing is it deletes half at a time. Lets say there is 10 deleted items and i run this macro, there will then be 5 emails moved, then i run again and it delets another 3....:dunno

[JP2112]

When you use the Move Method, you change the Items Collection represented by objTrash. So let's say you start with 10 items:

1 2 3 4 5 6 7 8 9 10

Every other item should get moved:

1 2 3 4 5 6 7 8 9 10 (items 1,3,5,7,9 moved)

That's why you went from 10 to 5 items on the first go. So now you only have items 2, 4, 6, 8, 10. When you run the code again, every other item will be moved:

2 4 6 8 10

That's why three were moved the second time.

What you need to do is use a regular For loop and loop backwards using the item index. Something like


For i = objTrash.Count To 1 Step -1
If objTrash.Item(i).Class = olMail Then
objTrash.Item(i).Move objFolder
End If
Next i

[Lalaland]

Thank you very much for the help, working great now...