基于word在主题和日期上使用Excel VBA从Outlook电子邮件中提取详细信息

Sub ExtractEmailDetails()
    Dim olApp As Object
    Dim olNamespace As Object
    Dim olFolder As Object
    Dim olMail As Object
    Dim xlApp As Object
    Dim xlWorkbook As Object
    Dim xlWorksheet As Object
    Dim i As Integer
    
    ' 创建Outlook应用程序对象
    Set olApp = CreateObject("Outlook.Application")
    ' 获取Outlook命名空间
    Set olNamespace = olApp.GetNamespace("MAPI")
    ' 获取收件箱文件夹
    Set olFolder = olNamespace.GetDefaultFolder(6) ' 6表示收件箱
    
    ' 创建Excel应用程序对象
    Set xlApp = CreateObject("Excel.Application")
    ' 创建新的工作簿
    Set xlWorkbook = xlApp.Workbooks.Add
    ' 获取第一个工作表
    Set xlWorksheet = xlWorkbook.Worksheets(1)
    
    ' 设置表头
    xlWorksheet.Cells(1, 1).Value = "主题"
    xlWorksheet.Cells(1, 2).Value = "日期"
    
    ' 遍历收件箱中的所有邮件
    i = 2 ' 从第二行开始写入数据
    For Each olMail In olFolder.Items
        ' 检查邮件主题和日期
        If InStr(1, olMail.Subject, "word", vbTextCompare) > 0 And DateValue(olMail.ReceivedTime) = Date Then
            ' 提取主题和日期信息
            xlWorksheet.Cells(i, 1).Value = olMail.Subject
            xlWorksheet.Cells(i, 2).Value = olMail.ReceivedTime
            i = i + 1
        End If
    Next olMail
    
    ' 保存并关闭Excel文件
    xlWorkbook.SaveAs "C:\Path\To\Save\ExtractedEmailDetails.xlsx"
    xlWorkbook.Close
    
    ' 释放对象
    Set xlWorksheet = Nothing
    Set xlWorkbook = Nothing
    xlApp.Quit
    Set xlApp = Nothing
    
    Set olFolder = Nothing
    Set olNamespace = Nothing
    Set olApp = Nothing
End Sub