VBA 展望。尝试从电子邮件正文中提取特定数据并导出到 Excel

VBA 展望：从电子邮件正文中提取特定数据并导出到 Excel

Sub ExtractDataFromEmail()
    ' 设置 Outlook 对象
    Dim objOutlook As Object
    Set objOutlook = CreateObject("Outlook.Application")
    
    ' 设置 Outlook 文件夹对象
    Dim objNamespace As Object
    Set objNamespace = objOutlook.GetNamespace("MAPI")
    Dim objFolder As Object
    Set objFolder = objNamespace.GetDefaultFolder(olFolderInbox).Folders("目标文件夹")
    
    ' 设置 Excel 对象
    Dim objExcel As Object
    Set objExcel = CreateObject("Excel.Application")
    Dim objWorkbook As Object
    Set objWorkbook = objExcel.Workbooks.Add
    
    ' 设置 Excel 工作表
    Dim objWorksheet As Object
    Set objWorksheet = objWorkbook.Worksheets(1)
    
    ' 设置行数和列数
    Dim rowNum As Integer
    rowNum = 1
    Dim colNum As Integer
    colNum = 1
    
    ' 循环遍历目标文件夹中的邮件
    Dim objMail As Object
    For Each objMail In objFolder.Items
        ' 提取特定数据并导出到 Excel
        objWorksheet.Cells(rowNum, colNum).Value = objMail.Subject
        objWorksheet.Cells(rowNum, colNum + 1).Value = objMail.ReceivedTime
        objWorksheet.Cells(rowNum, colNum + 2).Value = objMail.Body
        rowNum = rowNum + 1
    Next objMail
    
    ' 保存并关闭 Excel
    objWorkbook.SaveAs "C:\目标文件夹\提取数据.xlsx"
    objWorkbook.Close
    objExcel.Quit
    
    ' 释放对象
    Set objWorksheet = Nothing
    Set objWorkbook = Nothing
    Set objExcel = Nothing
    Set objFolder = Nothing
    Set objNamespace = Nothing
    Set objOutlook = Nothing
    
    MsgBox "数据提取完成！"
    
End Sub