Лучшие 50 писем из Outlook от нового к старому - PullRequest
Новая
       6

Лучшие 50 писем из Outlook от нового к старому

0 голосов
/ 22 октября 2018

Как получить первые 50 электронных писем из Outlook с помощью Excel VBA от нового к старому?

Я использую приведенный ниже код, однако при этом происходит загрузка писем с последнего на первое. 

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

Ответы [ 2 ]

0 голосов
/ 23 октября 2018

Сортировка коллекции элементов в папке. 

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
0 голосов
/ 22 октября 2018

Если при этом получаются неправильные 50 электронных писем, вы можете попробовать пройтись по пунктам в обратном порядке, например: 

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

Добавьте exit, как только вы нажмете 50, например: 

If counter = 50 Then Exit For

Кроме того, вы можете в качестве альтернативы сохранить существующий код, а затем добавить функцию к sort электронным письмам к полученной дате и сохранить только верхние 50

...