近日有网友咨询批量读取收件箱内所有列表的代码,特录制如下:
相关代码如下:
Sub ListMailSubject()
'列出所有账户的收件箱中的邮件标题
Set d = CreateObject("Scripting.Dictionary")
On Error Resume Next
Dim olApp As Outlook.Application
Dim nmsName As Namespace
Dim fldFolder As MAPIFolder
Dim subFolder As MAPIFolder
Dim objitem As Object
Dim i As Integer
Set olApp = Outlook.Application
Set nmsName = olApp.GetNamespace("MAPI")
For Each fldFolder In nmsName.Folders
For Each subFolder In fldFolder.Folders
If (subFolder.Name = "收件箱") Then
For Each objitem In subFolder.Items
If objitem.Class = olMail Then
Cells(2, 1).Offset(i, 1).Value = objitem.SenderName
Cells(2, 1).Offset(i, 2).Value = objitem.Subject
Cells(2, 1).Offset(i, 3).Value = objitem.SentOn
i = i + 1
End If
Next
End If
Next
Next
end sub
备 注:
需要引用一下Microsoft outlook的选项,如下图: