从最新电子邮件中下载主题包含特定文本的附件

Question

我的代码可以从收件箱中的最后一封电子邮件中下载附件 (xlsb)。

我有两个问题：

1 - 我需要更改它，以便它首先查找第一封电子邮件（最新的）。

2 - 它应该只查找主题包含以下词的电子邮件：DOCUMENT_APP（名称各不相同，但其中始终包含 document_app，因此需要使用通配符）

这是我的代码，它查找最旧的电子邮件并保存 xlsb 附件文件（忽略主题）：

Sub DownloadAttachmentFirstEmail()

    Application.StatusBar = False
    Application.StatusBar = "Downloading email"
    Application.DisplayAlerts = False
    Dim oOlAp As Object, oOlns As Object, oOlInb As Object
    Dim oOlItm As Object, oOlAtch As Object    
    
    '~~> New File Name for the attachment
    Dim NewFileName As String
    NewFileName = AttachmentPath & Format(Date, "DD-MM-YYYY") & "-"
    
    '~~> Get Outlook instance
    Set oOlAp = GetObject(, "Outlook.application")
    Set oOlns = oOlAp.GetNamespace("MAPI")
    Set oOlInb = oOlns.GetDefaultFolder(olFolderInbox)
    
    For Each oOlItm In oOlInb.Items
      
        '~~> Check if the email actually has an attachment
        If oOlItm.Attachments.Count <> 0 Then
            For Each oOlAtch In oOlItm.Attachments    
                 
                If Right(oOlAtch.Filename, 4) = "xlsb" Then
                    oOlAtch.SaveAsFile NewFileName & oOlAtch.Filename
                    MsgBox "SAVED"
                    Exit Sub
                End If

            Next
               
        Else
            
        End If
          
    Next
       
    ' DO SOMETHING
     
End Sub

对于问题号。 2、我尝试改变：

For Each oOlItm In oOlInb.Items

到：

For Each oOlItm In oOlInb.Items.Restrict("[Subject] = ""*DOCUMENT_APP*""")

它没有给出错误，它只是退出子。

Answer 1

niton 提供了一个有用的链接，我可以通过以下方式完成它：

  strFilter = "@SQL=" & Chr(34) & "urn:schemas:httpmail:subject" & Chr(34) & " like '%sketch%'"