Excel VBA Outlook搜索多个条件(ID和日期)

Sub SearchEmails()
    Dim olApp As Object
    Dim olNamespace As Object
    Dim olFolder As Object
    Dim olItems As Object
    Dim olMail As Object
    Dim strFilter As String
    Dim strID As String
    Dim dtDate As Date
    
    ' 创建Outlook应用程序对象
    Set olApp = CreateObject("Outlook.Application")
    
    ' 获取Outlook命名空间
    Set olNamespace = olApp.GetNamespace("MAPI")
    
    ' 获取收件箱文件夹
    Set olFolder = olNamespace.GetDefaultFolder(6) ' 6表示收件箱
    
    ' 获取收件箱中的所有邮件
    Set olItems = olFolder.Items
    
    ' 设置搜索条件
    strID = "邮件ID" ' 替换为实际的邮件ID
    dtDate = "日期" ' 替换为实际的日期
    
    ' 构建筛选条件
    strFilter = "[EntryID] = '" & strID & "' And [ReceivedTime] >= '" & Format(dtDate, "yyyy-mm-dd") & "'"
    
    ' 应用筛选条件并获取符合条件的邮件
    Set olMail = olItems.Find(strFilter)
    
    ' 遍历符合条件的邮件
    While Not olMail Is Nothing
        ' 处理符合条件的邮件
        ' 例如，可以将邮件的主题、发件人等信息写入Excel中
        
        ' 获取下一封符合条件的邮件
        Set olMail = olItems.FindNext
    Wend
    
    ' 释放对象
    Set olMail = Nothing
    Set olItems = Nothing
    Set olFolder = Nothing
    Set olNamespace = Nothing
    Set olApp = Nothing
End Sub