移动Outlook的邮件代码不移动最后一项

时间:2013-01-10 03:49:37

标签: vba outlook move outlook-2010 outlook-vba

我正在尝试将标记为读取的邮件从我的errorMails文件夹移动到我的sentErrors文件夹,这两个文件夹都位于我的mailOne文件夹中。我当前的代码适用于我标记为已读取的大多数邮件,但仅留下最后一封读取的邮件。

我错过了什么吗?

Public Sub moveToSentFolder()

Dim obj As Object
Dim Items As Outlook.Items
Dim OutMail As Outlook.MailItem

Dim archiveFolder As Outlook.Folder
Dim mailOneFolder As Outlook.Folder
Dim sentErrorFolder As Outlook.Folder
Dim dumpErrorFolder As Outlook.Folder

Set archiveFolder = Outlook.Session.Folders("Archives")
Set mailOneFolder = archiveFolder.Folders("mailOne")
Set errorFolder = ehealthFolder.Folders("errorMails")
Set dumpErrorFolder = ehealthFolder.Folders("sentErrors")

'Dim Message As MailItem

Set Folder = Application.Session.GetDefaultFolder(olFolderInbox)
Set Items = errorFolder.Items

For i = Items.Count - 1 To 0 Step -1

    With Items(i)

        ''Error 438 is returned when .receivedtime is not supported
        On Error Resume Next

        If .UnRead = False Then
            If Err.Number = 0 Then
                .Move dumpErrorFolder
            Else
                Err.Clear
            End If
        End If
    MsgBox i 'debug
    End With

Next

'For some reason the commented out code below only seems to move half of all the read mails, so I have to run the macro more than once to clear folder of read mails - this code now unused
'For Each Message In Items
    'If Message.UnRead = False Then
    ''Message.Move dumpErrorFolder
    'i = i + 1
    'End If
'Next Message

End Sub

1 个答案:

答案 0 :(得分:2)

在VBA中,项目可以具有不同的索引边界 - 使用option baseTo子句控制。在Office中,数组从位置1( 1-based )开始编制索引,而不是0( 0-based )。您需要更改FOR循环以适应此更改。

For i = Items.Count To 1 Step -1

作为另一种选择,您可以利用UBoundLBound来确定适当的索引边界。

For i = UBound(Items) To LBound(Items) Step -1