Question

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

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

    int lastBlock = CoatRandom.randomRule.getLastBlock();            
    lastBlock = lastBlock % 2 == 0 ? lastBlock + 1 : lastBlock - 1;

    Clothes[askedCoatRandom.getRandom()].setCurrentChildIndex(lastBlock);
    CoatRandom.randomRule.addBlock(lastBlock);
    badCoatRandom.randomRule.addBlock(lastBlock);

Answer 1

如果您只是想保存在“ 1/14/2019”收到的电子邮件附件，则不需要

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方法的速度会大大提高，尤其是在大型集合中只有少数项目被发现的情况下。}

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

Answer 2

请勿循环浏览文件夹中的所有项目-有些文件夹可能包含成千上万的邮件。将Items.Find/FindNext或Items.Restrict与"[ReceivedTime] >= '2019-01-14' AND [ReceivedTime] < '2019-01-15'"之类的查询一起使用。

对于Items.Find/FindNext，跳过电子邮件不会有问题。对于Items.Restrict，请使用从倒数到1步-1的递减循环。

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

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

3 个答案: