Question

如何使用Excel VBA从Outlook中获得新邮件到旧邮件中来自Outlook的前50名电子邮件？

我正在使用下面的代码，但这是从最后到第一个获取电子邮件。

Sub GetFromInbox()
Dim olApp As Outlook.Application
Dim olNs As Namespace
Dim Fldr As MAPIFolder
Dim olMail As Variant
Dim i As Integer

Set olApp = New Outlook.Application
Set olNs = olApp.GetNamespace("MAPI")

Set Fldr = olNs.GetDefaultFolder(olFolderInbox)

i = 1
x = Date

For Each olMail In Fldr.Items

    ActiveSheet.Cells(i, 1).Value = olMail.Subject
    ActiveSheet.Cells(i, 2).Value = olMail.ReceivedTime
    ActiveSheet.Cells(i, 3).Value = olMail.SenderName
    i = i + 1

Next olMail

Set Fldr = Nothing
Set olNs = Nothing
Set olApp = Nothing
End Sub

Answer 1

对文件夹中的项目进行排序。

Option Explicit

Sub GetFromInbox()

Dim olApp As outlook.Application
Dim olNs As Namespace
Dim Fldr As MAPIFolder

Dim sortItems As Items
Dim olObj As Object

Dim i As Long
Dim maxIter As Long

Set olApp = New outlook.Application
Set olNs = olApp.GetNamespace("MAPI")

Set Fldr = olNs.GetDefaultFolder(olFolderInbox)

' Sort a collection of items, not Fldr.Items
Set sortItems = Fldr.Items
sortItems.Sort "[Received]", True

If sortItems.count > 50 Then
    maxIter = 50
Else
    maxIter = sortItems.count
End If

For i = 1 To maxIter

    Set olObj = sortItems(i)

    If olObj.Class = olMail Then
        ActiveSheet.Cells(i, 1).Value = olObj.subject
        ActiveSheet.Cells(i, 2).Value = olObj.ReceivedTime
        ActiveSheet.Cells(i, 3).Value = olObj.senderName
    End If

Next

Set olObj = Nothing
Set sortItems = Nothing
Set Fldr = Nothing
Set olNs = Nothing
Set olApp = Nothing

End Sub

Answer 2

如果这抓取了错误的50封电子邮件，您可以尝试以相反的方式逐步浏览邮件：

For i = Fldr.Items.Count To Fldr.Items.Count - 50 Step -1
ActiveSheet.Cells(i, 1).Value = Fldr.Items(i).Subject
etc...

一旦您达到50，就添加一个exit，例如：

If counter = 50 Then Exit For

此外，您也可以保留现有代码，然后按收到日期将功能添加到sort电子邮件中，并且只保留前50名

从Outlook到新邮件到旧邮件的前50名电子邮件

2 个答案: