按 ReceivedTime 排序导致自动化错误

Question

我正在尝试从 outlook 文件夹中下载特定附件，当我按升序对邮箱进行排序时它起作用了。当我按降序排序时，突然出现自动化错误。

Option Explicit

Sub Taxinfo()

Dim folder As Outlook.MAPIFolder
Dim olApp As Outlook.Application
Dim olNS As Outlook.Namespace
Dim olfldr As Outlook.MAPIFolder
Dim sharedemail As Outlook.Recipient
Dim olMail As Variant
Dim myTasks As Outlook.Items
Dim itm As Outlook.MailItem
Dim objAtt As Outlook.Attachment
Dim y As Workbook
'Dim BodyText
Set y = Workbooks.Open("Current working spreadsheet here")
'Dim daysAgo As Long


Dim priorSaveFolder As Object
Set priorSaveFolder = y.Sheets("VBA Inputs").Range("B10") 'this is just the intended save location
'daysAgo = 3 'not currently being used

'Find Mailbox to search
Set olApp = New Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")
Set sharedemail = olNS.CreateRecipient("mailbox i'm using")
Set olfldr = olNS.GetSharedDefaultFolder(sharedemail, olFolderInbox)
Set folder = olfldr
Set myTasks = folder.Items
Set myTasks = folder.Items.Restrict("[Subject]='Email Subject'")
myTasks.Sort "[ReceivedTime]", False 
'if I change this to True, I get "Run-time error '440': Automation Error


For Each olMail In myTasks
    If olMail.Attachments.Count > 0 Then
        While olMail.Attachments.Count > 0
'This times out or doesn't work for some reason
'            For Each objAtt In olMail.Attachments
'                If InStr(objAtt.Filename, "MTTAX") Or InStr(objAtt.Filename, "mttax") Then
'                    olMail.Attachments(1).SaveAsFile priorSaveFolder & "MTTAX.html"
'                    Exit For
'                End If
'            Next objAtt
            If (Left$(olMail.Attachments(1).Filename, 5) = "mttax" Or Left$(olMail.Attachments(1).Filename, 5) = "MTTAX") Then
                olMail.Attachments(1).SaveAsFile priorSaveFolder & "MTTAX.html"
            End If
            If (Left$(olMail.Attachments(1).Filename, 5) = "mttax" Or Left$(olMail.Attachments(1).Filename, 5) = "MTTAX") Then
                Exit For
            End If
            If (Left$(olMail.Attachments(2).Filename, 5) = "mttax" Or Left$(olMail.Attachments(2).Filename, 5) = "MTTAX") Then
                olMail.Attachments(2).SaveAsFile priorSaveFolder & "MTTAX.html"
            End If
            If (Left$(olMail.Attachments(2).Filename, 5) = "mttax" Or Left$(olMail.Attachments(2).Filename, 5) = "MTTAX") Then
                Exit For
            End If
            If (Left$(olMail.Attachments(3).Filename, 5) = "mttax" Or Left$(olMail.Attachments(3).Filename, 5) = "MTTAX") Then
                olMail.Attachments(3).SaveAsFile priorSaveFolder & "MTTAX.html"
            End If
            If (Left$(olMail.Attachments(3).Filename, 5) = "mttax" Or Left$(olMail.Attachments(3).Filename, 5) = "MTTAX") Then
                Exit For
            End If
            If (Left$(olMail.Attachments(4).Filename, 5) = "mttax" Or Left$(olMail.Attachments(4).Filename, 5) = "MTTAX") Then
                olMail.Attachments(4).SaveAsFile priorSaveFolder & "MTTAX.html"
            End If
            If (Left$(olMail.Attachments(4).Filename, 5) = "mttax" Or Left$(olMail.Attachments(4).Filename, 5) = "MTTAX") Then
                Exit For
            End If
            If (Left$(olMail.Attachments(5).Filename, 5) = "mttax" Or Left$(olMail.Attachments(5).Filename, 5) = "MTTAX") Then
                olMail.Attachments(5).SaveAsFile priorSaveFolder & "MTTAX.html"
            End If
            If (Left$(olMail.Attachments(5).Filename, 5) = "mttax" Or Left$(olMail.Attachments(5).Filename, 5) = "MTTAX") Then
                Exit For
            End If
            If (Left$(olMail.Attachments(6).Filename, 5) = "mttax" Or Left$(olMail.Attachments(6).Filename, 5) = "MTTAX") Then
                olMail.Attachments(6).SaveAsFile priorSaveFolder & "MTTAX.html"
            End If
            If (Left$(olMail.Attachments(6).Filename, 5) = "mttax" Or Left$(olMail.Attachments(6).Filename, 5) = "MTTAX") Then
                Exit For
            End If
            If (Left$(olMail.Attachments(7).Filename, 5) = "mttax" Or Left$(olMail.Attachments(7).Filename, 5) = "MTTAX") Then
                olMail.Attachments(7).SaveAsFile priorSaveFolder & "MTTAX.html"
            End If
            If (Left$(olMail.Attachments(7).Filename, 5) = "mttax" Or Left$(olMail.Attachments(7).Filename, 5) = "MTTAX") Then
                Exit For
            End If
        Wend
    End If
Next olMail

Dim IE As InternetExplorer
Dim url As String

url = priorSaveFolder & "MTTAX.html"

Set IE = New InternetExplorerMedium
    With IE
        .Visible = True
        .navigate url
        Do Until .readyState = 4: DoEvents: Loop
    End With

    IE.ExecWB 17, 0 '// SelectAll
    IE.ExecWB 12, 2 '// Copy selection
    y.Sheets("Tax").Range("A1").PasteSpecial
    IE.Quit




End Sub

代码在 myTasks.sort“[ReceivedTime]”为 False 时完美运行，除了它从 2019 年的电子邮件中提取附件。如果我尝试对另一个方向进行排序，则会出错。如何提取最近的电子邮件？

Answer 1

问题最终出现在过滤附件的脚本中。删除这些行并用以下内容替换它们解决了我的问题：

For Each olMail In myTasks
    If olMail.Attachments.Count > 0 Then
        For Each objAtt In olMail.Attachments
            If InStr(objAtt.Filename, "MTTAX") Or InStr(objAtt.Filename, "mttax") Then
                objAtt.SaveAsFile priorSaveFolder & "MTTAX.html"
                Exit For
            End If
        Next objAtt
    End If
Next olMail

按 ReceivedTime 排序导致自动化错误

Sorting by ReceivedTime causing automation error

outlook

vba