outlook - Excel VBA For loop stops after half of the emails were moved to another Folder

Question

I want to move mail with a specific subject into a specific folder. It works fine for the first half of the mail I want to move, but after exactly half of the mail is filtered to the folder, it stops and doesn't do anything.

Sub getDataFromOutlook()
    Dim OutlookApp As Outlook.Application
    Dim OutlookNamespace As Namespace
    Dim Folder As MAPIFolder
    Dim OutlookMail As Variant
    Dim objOwner As Outlook.Recipient
    Dim i As Integer
    Dim count As Integer
    Dim FolderSuccess As Object
    Dim FolderFail As Object
    Dim Subject As String
    Dim A() As String
    Dim B As String

    Set OutlookApp = New Outlook.Application
    Set OutlookNamespace = OutlookApp.GetNamespace("MAPI")
    Set objOwner = OutlookNamespace.CreateRecipient("[email protected]")
    objOwner.Resolve
    Set Folder = OutlookNamespace.GetSharedDefaultFolder(objOwner, olFolderInbox).Parent.Folders("KD-Center")
    Set FolderSuccess = OutlookNamespace.GetSharedDefaultFolder(objOwner, olFolderInbox).Parent.Folders("Test")
    Set FolderFail = OutlookNamespace.GetSharedDefaultFolder(objOwner, olFolderInbox).Parent.Folders("Test2")

    i = 1
    B = ("Success")
    count = 0

    For Each OutlookMail In Folder.Items
        count = count + 1
        Range("count").Offset(i, 0) = count
    Next OutlookMail

    For Each OutlookMail In Folder.Items
       If OutlookMail.ReceivedTime >= Range("email_Receipt_Date").Value Then
            Subject = OutlookMail.Subject
            A() = Split(Subject)
                If A(1) = B Then
                    Range("email_Status").Offset(i, 0) = True
                    Range("email_Status").Offset(i, 0).Columns.AutoFit
                    Range("email_Status").Offset(i, 0).VerticalAlignment = xlTop
                    OutlookMail.Move FolderSuccess
                End If
                If A(1) <> B Then
                    Range("email_Status").Offset(i, 0) = False
                    Range("email_Status").Offset(i, 0).Columns.AutoFit
                    Range("email_Status").Offset(i, 0).VerticalAlignment = xlTop
                    OutlookMail.Move FolderFail
                End If
            i = i + 1
        End If
    Next OutlookMail

    Set Folder = Nothing
    Set OutlookNamespace = Nothing
    Set OutlookApp = Nothing

End Sub

If I remove the two move functions out of the if statements all mail is filtered.

question from:https://stackoverflow.com/questions/66048660/excel-vba-for-loop-stops-after-half-of-the-emails-were-moved-to-another-folder

Answer 1

Waitting for answers