|
Sub ExportEmailData()
Dim olApp As Outlook.Application
Dim olNamespace As Outlook.Namespace
Dim olFolder As Outlook.MAPIFolder
Dim olItem As Object
Dim i As Integer
Dim ws As Worksheet
' 创建一个新的工作表
Set ws = ThisWorkbook.Sheets.Add
' 添加标题行
ws.Cells(1, 1).Value = "收件人邮箱"
ws.Cells(1, 2).Value = "发件日期"
' 初始化Outlook应用程序和命名空间
Set olApp = New Outlook.Application
Set olNamespace = olApp.GetNamespace("MAPI")
' 获取收件箱文件夹
Set olFolder = olNamespace.GetDefaultFolder(olFolderInbox)
' 遍历收件箱中的邮件
i = 2 ' 从第二行开始写入数据
For Each olItem In olFolder.Items
If TypeOf olItem Is Outlook.MailItem Then
' 写入收件人邮箱和发件日期到工作表
ws.Cells(i, 1).Value = olItem.To
ws.Cells(i, 2).Value = olItem.ReceivedTime
i = i + 1
End If
Next olItem
' 释放对象
Set olItem = Nothing
Set olFolder = Nothing
Set olNamespace = Nothing
Set olApp = Nothing
End Sub |
|