Скрипт VBA для Outlook срабатывает лишь раз

Sub TrashingMail()

Set myOlApp = CreateObject("Outlook.Application")
Dim myNameSpace As NameSpace
Set myNameSpace = myOlApp.GetNamespace("MAPI")
Dim myExplorer As Explorer
Set myExplorer = myOlApp.ActiveExplorer

folderType = myExplorer.CurrentFolder.DefaultItemType

If TypeName(myExplorer) = "Nothing" Or folderType <> 0 Then
GoTo invalidMailbox
End If

Set thisFolder = myExplorer.CurrentFolder
Do Until thisFolder.Parent = myNameSpace
    Set thisFolder = thisFolder.Parent
Loop
Set accountFolder = thisFolder

Dim selectedItems As Selection
Set selectedItems = myExplorer.Selection
Dim currentMailItem As MailItem
Dim iterator As Long

For iterator = 1 To selectedItems.Count
Set currentMailItem = selectedItems.Item(iterator)

Set thisFolder = myExplorer.CurrentFolder
Set trashFolder = accountFolder.Folders("Удаленные")
currentMailItem.Move (trashFolder)

Next

Dim myBar As CommandBar
Set myBar = Application.ActiveExplorer.CommandBars("Menu Bar")
Dim myButtonPopup As CommandBarPopup
Set myButtonPopup = myBar.Controls("&Правка")
Dim myButtonPopupP As CommandBarPopup
Set myButtonPopupP = myButtonPopup.Controls("О&чистить")
Dim myButton As CommandBarButton
Set myButton = myButtonPopupP.Controls("Очистить помеченные &элементы для всех учетных записей")
SendKeys "~"
myButton.Execute

Exit Sub

invalidMailbox:
MsgBox ("Это не почтовая папка!")
Exit Sub

End Sub

currentMailItem.Move (trashFolder)