Archive mail with an Excel macro

Question

I'm trying to archive emails based on their subject. the code is in Excel. With the code below i try to move the emails from a folder of my choice to the folder "Arrivo". To test it I have 3 emails in the starting folder, 2 of them containing the word "sas" in the subject. The output should be the 2 emails in the new folder and a msgbox telling me how may emails have been moved.

Sub Archivia_Mail()

Dim outlookApp
Dim olNs As Outlook.Namespace
Dim Fldr As Outlook.MAPIFolder
Dim olMail As Variant
Dim myTasks
Dim OlApp As New Outlook.Application 'Instance of Microsoft Outlook application
Dim FolderChosen As Outlook.MAPIFolder 'Folder selected by user
Dim myInbox As Outlook.Folder
Dim myDestFolder As Outlook.Folder


Set outlookApp = CreateObject("Outlook.Application")
Set olNs = outlookApp.GetNamespace("MAPI")
Set FolderChosen = olNs.PickFolder
Set Fldr = FolderChosen
Set myTasks = Fldr.Items
Set myInbox = olNs.GetDefaultFolder(olFolderInbox)
Set myDestFolder = myInbox.Folders("Arrivo")

contamail = 0

For Each olMail In myTasks
    If (InStr(1, olMail.Subject, "sas", vbTextCompare) > 0) Then

        'olmail.Display

        olMail.Move myDestFolder
        contamail = contamail + 1
    End If
Next

MsgBox ("Archiviate " & contamail & " email")
End Sub

right now the code only archive 1 email, stopping after that. I cannot figure out why it behaves this way, can you help me?

Possible duplicate of [For Each loop: How to adjust code to move files in one run rather than multiple](https://stackoverflow.com/questions/32252693/for-each-loop-how-to-adjust-code-to-move-files-in-one-run-rather-than-multiple) — niton, Jul 11 '17 at 02:15
Possible duplicate of [Can I iterate through all Outlook emails in a folder including sub-folders?](https://stackoverflow.com/questions/2272361/can-i-iterate-through-all-outlook-emails-in-a-folder-including-sub-folders) — niton, Nov 29 '17 at 01:15

score 1 · Answer 1 · answered Jan 07 '16 at 09:55

Solved the problem.

using a classic cycle was the problem. Using the following code:

    For iCount = myTasks.Count To 1 Step -1

    If (InStr(1, myTasks(iCount).Subject, "sas", vbTextCompare) > 0) Then

        'olmail.Display

        myTasks(iCount).Move myDestFolder
        contamail = contamail + 1
    End If
Next

solved the issue

Archive mail with an Excel macro

1 Answers1