Welcome to OStack Knowledge Sharing Community for programmer and developer-Open, Learning and Share
Welcome To Ask or Share your Answers For Others

Categories

0 votes
1.4k views
in Technique[技术] by (71.8m points)

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

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

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome To Ask or Share your Answers For Others

1 Answer

0 votes
by (71.8m points)
Waitting for answers

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome to OStack Knowledge Sharing Community for programmer and developer-Open, Learning and Share
Click Here to Ask a Question

...