为什么从最新的电子邮件跳过文件循环进入电子邮件收件箱？

Question

我正在尝试根据接收日期下载 Outlook 收件箱中的电子邮件附件。我的代码下载附件，但它会跳过文件。

例如：我试图从最新的电子邮件（接收日期：01/14/2019）循环电子邮件。在循环了大约 10-15 封电子邮件后，它突然跳到阅读 2018 年 7 月 12 日收到的电子邮件。

Sub saveemailattachment()

'Application setup
Dim objOL As Outlook.Application
Set objOL = New Outlook.Application

Dim ONS As Outlook.Namespace
Set ONS = objOL.GetNamespace("MAPI")

Dim olfolder As Outlook.Folder
Set olfolder = ONS.GetDefaultFolder(olFolderInbox)

Dim olmail As Outlook.MailItem
Set olmail = objOL.CreateItem(olMailItem)

Dim olattachment As Outlook.Attachment
Dim i As Long
Dim filename As String
Dim VAR As Date

'Loop through all item in Inbox
For i = olfolder.Items.Count To 1 Step -1 'Iterates from the end backwards

    Set olmail = olfolder.Items(i)

    For Each olmail In olfolder

        VAR = Format(olmail.ReceivedTime, "MM/DD/YYYY")
        filename = olmail.Subject

        If VAR = "1/14/2019" Then  
            For Each olattachment In olmail.Attachments
                olattachment.SaveAsFile "C:\Users\Rui_Gaalh\Desktop\Email attachment\" & olattachment.filename
            Next

        Else

        End If

        'Mark email as read
        olmail.UnRead = False
        DoEvents
        olmail.Save
    Next
Next

MsgBox "DONE"

End Sub

Answer 1

不要遍历文件夹中的所有项目 - 某些文件夹可能包含数万条消息。将Items.Find/FindNext 或Items.Restrict 与"[ReceivedTime] >= '2019-01-14' AND [ReceivedTime] < '2019-01-15'" 之类的查询一起使用。

如果是Items.Find/FindNext，您不会有跳过电子邮件的问题。在Items.Restrict 的情况下，使用从倒计时到 1 步 -1 的向下循环。

Answer 2

如果您只是想保存在“2019 年 1 月 14 日”收到的电子邮件附件，那么不需要

For Each olmail In olfolder

Next 

当你已经在使用时

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

next 

这是另一个objOL.CreateItem(olMailItem)??删除它，也可以Dim olmail as a generic Object - 在您的收件箱中还有 MailItem 以外的其他对象。

Dim olmail As Outlook.MailItem
Set olmail = objOL.CreateItem(olMailItem)

在循环中设置olMail，然后检查olMail是否为MailItem

例子

Option Explicit
Sub saveemailattachment()
    'Application setup
    Dim objOL As Outlook.Application
    Set objOL = New Outlook.Application

    Dim ONS As Outlook.NameSpace
    Set ONS = objOL.GetNamespace("MAPI")

    Dim olfolder As Outlook.Folder
    Set olfolder = ONS.GetDefaultFolder(olFolderInbox)

    Dim olmail As Object

    Dim olattachment As Outlook.attachment
    Dim i As Long
    Dim filename As String
    Dim VAR As Date


    'Loop through all item in Inbox
    For i = olfolder.items.Count To 1 Step -1 'Iterates from the end backwards
        DoEvents
        Set olmail = olfolder.items(i)

        If TypeOf olmail Is Outlook.MailItem Then

            VAR = Format(olmail.ReceivedTime, "MM/DD/YYYY")
            filename = olmail.Subject

            If VAR = "1/14/2019" Then

                For Each olattachment In olmail.Attachments

                    olattachment.SaveAsFile _
                    "C:\Users\Rui_Gaalh\Desktop\Email attachment\" _ 
                            & olattachment.filename

                Next
                'Mark email as read
                olmail.UnRead = False
            End If
        End If

    Next

    MsgBox "DONE"

End Sub

你也应该看看Items.Restrict方法

https://stackoverflow.com/a/48311864/4539709

---

_{Items.Restrict method 是使用 Find 方法或 FindNext 方法迭代集合中特定项目的替代方法。如果项目数量较少，则 Find 或 FindNext 方法比过滤更快。如果集合中有大量项目，则 Restrict 方法的速度明显更快，尤其是在大型集合中只需要找到少数项目的情况下。}

---

_{Filtering Items Using a String Comparison DASL 过滤器支持包括等价、前缀、短语和子字符串匹配。请注意，当您对主题属性进行过滤时，会忽略诸如“RE:”和“FW:”之类的前缀。}

Answer 3

感谢您的所有建议。该代码完美运行。请在下面找到最终代码：

    Option Explicit
    Sub saveemailattachment()

    'Application setup
     Dim objOL As Outlook.Application
     Set objOL = New Outlook.Application

    Dim ONS As Outlook.Namespace
    Set ONS = objOL.GetNamespace("MAPI")

    Dim olfolder As Outlook.Folder
    Set olfolder = ONS.GetDefaultFolder(olFolderInbox)

    Dim olmail As Object

    Dim olattachment As Outlook.Attachment
    Dim i As Long
    Dim InboxMsg As Object
    Dim filename As String


    'Set variables
    Dim Sunday As Date
    Dim Monday As Date
    Dim Savefolder As String

    Dim VAR As Date
    Dim Timestamp As String

    Monday = ThisWorkbook.Worksheets(1).Range("B2")
    Sunday = ThisWorkbook.Worksheets(1).Range("B3")
    Savefolder = ThisWorkbook.Worksheets(1).Range("B4")

'Loop through all item in Inbox
For i = olfolder.Items.Count To 1 Step -1 'Iterates from the end backwards
    DoEvents
    Set olmail = olfolder.Items(i)
    Application.Wait (Now + TimeValue("0:00:01"))


        'Check if olmail is emailitem
        If TypeOf olmail Is Outlook.MailItem Then

               'Set time fram
                VAR = olmail.ReceivedTime 'Set Received time
                Timestamp = Format(olmail.ReceivedTime, "YYYY-MM-DD-hhmmss") 'Set timestamp format


                If VAR <= Sunday And VAR >= Monday Then


                    For Each olattachment In olmail.Attachments
                    Application.Wait (Now + TimeValue("0:00:01"))


                    'Download excel file and non-L10 file only
                    If (Right(olattachment.filename, 4) = "xlsx" Or Right(olattachment.filename, 3) = "xls")Then

                        'Set file name
                        filename = Timestamp & "_" & olattachment.filename

                        'Download email
                        olattachment.SaveAsFile Savefolder & "\" & filename

                        Application.Wait (Now + TimeValue("0:00:02"))

                        End If
                    Next


                Else

                End If

                'Mark email as read
                olmail.UnRead = False
                DoEvents
                olmail.Save

    Else
    End If
Next


MsgBox "DONE"

End Sub