CODEWITHSUNDEEP
vbaloopsoutlookiterationmove
Qudsia
Qudsia

Reputation: 53

Outlook VBA macro loop moving emails in unspecified batches

This is my first time using VBA with Outlook. I got my code to work but encountered a strange problem as I added a step

The tasks are:

  1. Save emails from subfolder1 to a network folder (this worked fine)
  2. After saving, Move emails from subfolder1 to subfolder2 (adding this step caused issue) (both subfolder1 and subfolder2 are subfolders in Outlook under the default Inbox folder)

Adding a single line of code for 2nd task caused a strange problem: For the same 12 emails I was testing, the code would run without error messages but would only process few emails at a time. I would have to re-run code and it took 4 executions to finish all 12 emails.

Emails are processed in this order:

There are no conditions in the code to stop it.

When I run the same code without adding the line for task#2, the macro processes all 12 emails in one go. Commenting out this one line solves the "batchiness":
oMail.Move myFolder2

The remaining emails do get processed in subsequent runs; just not in one go.

Here's my code, borrowed mostly from: Macro to save selected emails of Outlook in Windows folder

Sub OutlookToDrive()

Dim myNameSpace As Outlook.NameSpace 'Object '(or Outlook.NameSpace)
Dim myFolder1 As Outlook.MAPIFolder  'Object '(or Outlook.MAPIFolder) folder to move FROM
Dim myFolder2 As Outlook.MAPIFolder 'Object '(or Outlook.MAPIFolder) Folder to move TO
Dim oMail As Object 'not specifying as 'mailobject' to include meeting invites
Dim sFileName As String
Dim dtdate As Date
Dim sDestinationFolder As String
Dim sFullPath As String
Dim sFolder1Name As String  'name of folder to move FROM
Dim sFolder2Name As String  'name of folder to move TO
Dim iCount As Integer

sDestinationFolder = "H:\PROD\Supplimentary_Info\"

 'subfolders under the default Inbox folder:
    sFolder1Name = "MoveFrom" 
    sFolder2Name = "MoveTo"    

Set myNameSpace = Application.GetNamespace("MAPI")
Set myFolder1 = myNameSpace.GetDefaultFolder(olFolderInbox).Folders(sFolder1Name)
Set myFolder2 = myNameSpace.GetDefaultFolder(olFolderInbox).Folders(sFolder2Name)

'initialize count
iCount = 0

For Each oMail In myFolder1.items

    sFileName = oMail.Subject   'Use email subject as file name

'"ReplaceCharsForFileName" is a function that I'm not including; no issues        
  ReplaceCharsForFileName sFileName, "()"  'replace characters

    dtdate = oMail.ReceivedTime
    sFileName = Format(dtdate, "yyyymmdd", vbUseSystemDayOfWeek, vbUseSystem) & _
            Format(dtdate, "-hhnnss", vbUseSystemDayOfWeek, vbUseSystem) & "-" & sFileName & ".msg"

    sFullPath = sDestinationFolder & "\" & sFileName

    If Dir(sFullPath) = "" Then
        iCount = iCount + 1

        Debug.Print TypeName(oMail) & " " & sFileName
        oMail.SaveAs sFullPath, olMSG   'save to specified path
        DoEvents

        oMail.Move myFolder2 'THIS LINE CAUSING ISSUE; BUT FINE IN BATCHES
        DoEvents
    End If        

Next

    MsgBox "Found " & iCount & " new emails in folder """ & myFolder1 & """ to save to path: " & vbNewLine & vbNewLine & sDestinationFolder

End Sub

In trying to diagnose the problem, made a list of emails in batches they appear using debug.print list. (Bold prefix number is the order they sit in the mail folder, bold prefix text is email type)

enter image description here

I changed the number of total emails for testing. New batches remained consistent the number of times I repeated:
Total 15 email; batches 8, 4, 2, 1
Total 6 emails; batches 3, 2, 1
Total 5 emails; batches 3, 1, 1
Total 3 emails; batches 2, 1
Total 2 emails; Both went through. yeah!

(The 15 count group was made by adding 3 new emails to original 12 emails in folder1. The 12 emails changed order in which they were processed within new test group. But re-running the macro always gave the same emails in same new batches every time I tested)

Upvotes: 1

Views: 648

Answers (2)

Qudsia
Qudsia

Reputation: 53

Here's modified response posted by Alex de Jong.
Code works nicely when loop is changed to: 

For i = myFolder1.Items.count to 1 step -1
   Set oMail = myFolder1.Items(i)

   'Do your thing

Next i

Upvotes: 0

Alex de Jong
Alex de Jong

Reputation: 1267

Try this:

For i = myFolder1.Items.count -1 to 0 step -1
   Set oMail = myFolder1.Items(i)
   'Do your thing

Next i

I suspect your loop skips an item because you remove your item from the folder.

Upvotes: 2

Related Questions