使用VBA将电子邮件正文复制到Excel中

Sub CopyEmailBodyToExcel()
    Dim OutlookApp As Object
    Dim OutlookNamespace As Object
    Dim Folder As Object
    Dim MailItem As Object
    Dim ExcelApp As Object
    Dim ExcelWorkbook As Object
    Dim ExcelWorksheet As Object
    Dim RowIndex As Integer
    
    ' 创建Outlook应用程序对象
    Set OutlookApp = CreateObject("Outlook.Application")
    ' 获取Outlook命名空间
    Set OutlookNamespace = OutlookApp.GetNamespace("MAPI")
    ' 获取收件箱文件夹
    Set Folder = OutlookNamespace.GetDefaultFolder(6) ' 6表示收件箱
    
    ' 创建Excel应用程序对象
    Set ExcelApp = CreateObject("Excel.Application")
    ' 打开Excel工作簿
    Set ExcelWorkbook = ExcelApp.Workbooks.Open("C:\Path\To\Your\Workbook.xlsx")
    ' 选择或创建工作表
    Set ExcelWorksheet = ExcelWorkbook.Sheets("Sheet1")
    
    ' 初始化行索引
    RowIndex = 1
    
    ' 遍历收件箱中的邮件
    For Each MailItem In Folder.Items
        ' 判断邮件是否已读
        If MailItem.UnRead = True Then
            ' 将邮件正文复制到Excel中的指定单元格
            ExcelWorksheet.Cells(RowIndex, 1).Value = MailItem.Body
            ' 标记邮件为已读
            MailItem.UnRead = False
            ' 增加行索引
            RowIndex = RowIndex + 1
        End If
    Next MailItem
    
    ' 保存并关闭Excel工作簿
    ExcelWorkbook.Save
    ExcelWorkbook.Close
    
    ' 退出Excel应用程序
    ExcelApp.Quit
    
    ' 释放对象
    Set OutlookApp = Nothing
    Set OutlookNamespace = Nothing
    Set Folder = Nothing
    Set MailItem = Nothing
    Set ExcelApp = Nothing
    Set ExcelWorkbook = Nothing
    Set ExcelWorksheet = Nothing
End Sub