Looping

[Spirit ICT]

How do I make the below loop until all emails are moved?

Sub MoveToFiled()

On Error Resume Next

Dim ns As Outlook.NameSpace

Dim moveToFolder As Outlook.MAPIFolder

Dim objItem As Outlook.MailItem

Set ns = Application.GetNamespace("MAPI")


Set moveToFolder = ns.Folders("Archive - X@spiritaero.com").Folders("Deleted")

If Application.ActiveExplorer.Selection.Count = 0 Then

MsgBox ("No item selected")

Exit Sub

End If

If moveToFolder Is Nothing Then

MsgBox "Target folder not found!", vbOKOnly + vbExclamation, "Move Macro Error"

End If

For Each objItem In Application.ActiveExplorer.Selection

If moveToFolder.DefaultItemType = olMailItem Then

If objItem.Class = olMail Then

objItem.Move moveToFolder

End If

End If

Next

Set objItem = Nothing

Set moveToFolder = Nothing

Set ns = Nothing

End Sub

 

[Diane Poremsky]

this should be all you need to do...
For Each objItem In Application.ActiveExplorer.Selection
' do whatever
Next

if you are setting the move to folder in the code:
Set moveToFolder = ns.Folders("Archive - X@spiritaero.com").Folders("Deleted")

you don't need this:
If moveToFolder.DefaultItemType = olMailItem Then

i would use this:

For Each objItem In Application.ActiveExplorer.Selection

If objItem.Class = olMail Then

objItem.Move moveToFolder

End If

Next

to avoid errors if you select a non-mail item, you can use
Dim objItem As Object at the top and If objItem.Class = olMail Then will make sure only mail is moved.

i have a macro sample that works with selected item at Working with All Items in a Folder or Selected Items

 

[Spirit ICT]

this should be all you need to do...
For Each objItem In Application.ActiveExplorer.Selection
' do whatever
Next

if you are setting the move to folder in the code:
Set moveToFolder = ns.Folders("Archive - X@spiritaero.com").Folders("Deleted")

you don't need this:
If moveToFolder.DefaultItemType = olMailItem Then

i would use this:

For Each objItem In Application.ActiveExplorer.Selection

If objItem.Class = olMail Then

objItem.Move moveToFolder

End If

Next

to avoid errors if you select a non-mail item, you can use
Dim objItem As Object at the top and If objItem.Class = olMail Then will make sure only mail is moved.

i have a macro sample that works with selected item at Working with All Items in a Folder or Selected Items

Thank you for all the help. I'm still having an issue with it only moving a single email. How can I get it to repeatedly move one email at a time until the folder is empty?

 

[Diane Poremsky]

as written, to should work on the selection - if you select all, they should all move. if you always want to process all mail in the folder, you need to change it - Working with All Items in a Folder or Selected Items has a smple for that too.

 

[niton]

This is why I try to use down count loops only as I tend to forget about the index problem when moving or deleting.

For Each is simple to use but it is the same as For I = 1 to count.

Option Explicit

Sub MoveToFiled()

    ' Do not put at the start. Use for specific purpose
    ' On Error Resume Next
    ' Turn off this bypass as soon as the specific purpose is over
    ' On Error GoTo 0
    
    Dim ns As Outlook.NameSpace
    Dim moveToFolder As Outlook.MAPIFolder
    
    'Dim objItem As Outlook.mailitem
    ' One problem fixed
    Dim objItem As Object
    
    Dim selCount As Long
    Dim i As Long
    
    Set ns = Application.GetNamespace("MAPI")
    
    On Error Resume Next
    Set moveToFolder = ns.Folders("Archive - X@spiritaero.com").Folders("Deleted")
    On Error GoTo 0
    If moveToFolder Is Nothing Then
        MsgBox "Target folder not found!", vbOKOnly + vbExclamation, "Move Macro Error"
        GoTo ExitRoutine
    End If
    
    selCount = Application.ActiveExplorer.Selection.count
    
    If selCount = 0 Then
        MsgBox ("No item selected")
        GoTo ExitRoutine
    End If
    
    If moveToFolder.DefaultItemType = olMailItem Then
        For i = selCount To 1 Step -1
            Set objItem = Application.ActiveExplorer.Selection(i)
            If objItem.Class = olMail Then
                objItem.Move moveToFolder
            End If
        Next
    End If

ExitRoutine:
    Set objItem = Nothing
    Set moveToFolder = Nothing
    Set ns = Nothing

End Sub