根据名称将outlook导出中的单个条目获取到excel worksheet vba宏

Sub ExportOutlookItemToExcel()
    Dim olApp As Outlook.Application
    Dim olNamespace As Outlook.Namespace
    Dim olFolder As Outlook.Folder
    Dim olItem As Outlook.MailItem
    Dim xlApp As Excel.Application
    Dim xlWorkbook As Excel.Workbook
    Dim xlWorksheet As Excel.Worksheet
    Dim row As Integer
    
    ' 创建Outlook应用程序对象
    Set olApp = New Outlook.Application
    ' 获取Outlook命名空间
    Set olNamespace = olApp.GetNamespace("MAPI")
    ' 获取指定的Outlook文件夹（例如收件箱）
    Set olFolder = olNamespace.GetDefaultFolder(olFolderInbox)
    
    ' 创建Excel应用程序对象
    Set xlApp = New Excel.Application
    ' 创建新的工作簿
    Set xlWorkbook = xlApp.Workbooks.Add
    ' 获取第一个工作表
    Set xlWorksheet = xlWorkbook.Worksheets(1)
    
    ' 设置Excel工作表的标题行
    xlWorksheet.Cells(1, 1).Value = "发件人"
    xlWorksheet.Cells(1, 2).Value = "主题"
    xlWorksheet.Cells(1, 3).Value = "时间"
    
    ' 初始化行数
    row = 2
    
    ' 遍历Outlook文件夹中的每个邮件条目
    For Each olItem In olFolder.Items
        ' 判断是否为邮件条目
        If TypeOf olItem Is Outlook.MailItem Then
            ' 将邮件条目的信息写入Excel工作表
            xlWorksheet.Cells(row, 1).Value = olItem.SenderName
            xlWorksheet.Cells(row, 2).Value = olItem.Subject
            xlWorksheet.Cells(row, 3).Value = olItem.ReceivedTime
            ' 增加行数
            row = row + 1
        End If
    Next olItem
    
    ' 保存Excel工作簿
    xlWorkbook.SaveAs "C:\Path\To\Save\ExcelFile.xlsx"
    
    ' 关闭Excel应用程序
    xlApp.Quit
    
    ' 释放对象
    Set xlWorksheet = Nothing
    Set xlWorkbook = Nothing
    Set xlApp = Nothing
    Set olFolder = Nothing
    Set olNamespace = Nothing
    Set olApp = Nothing
    
    MsgBox "导出完成！"
End Sub