Looping

Status
Not open for further replies.

Spirit ICT

New Member
Outlook version
Outlook 2010 64 bit
Email Account
Exchange Server 2010
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

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
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:
Code:
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

New Member
Outlook version
Outlook 2010 64 bit
Email Account
Exchange Server 2010
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:
Code:
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?
 

niton

Member
Outlook version
Outlook 2010 32 bit
Email Account
Exchange Server 2010
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.

Code:
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
 
Status
Not open for further replies.
Top