Импортируйте самые последние электронные письма из Outlook в Excel (VBA)

Я потратил много времени на изучение этого вопроса, и мне еще предстоит найти полный ответ. То, что я хочу сделать, это получить 100 последних писем из Outlook и вставить их в книгу Excel. Я создал код (заимствованный из нескольких разных веб-сайтов), который выполнил это, но в нем отсутствует "самая последняя" часть.

Когда я выполняю этот код в Excel, распечатывается 101 строка с информацией, которую я указал, и это хорошо. Но это не с самыми последними электронными письмами. Если вы видите на изображении ниже, сейчас время 7:18 вечера, но электронные письма, которые импортируются в Excel, только с 14:17 сегодня и ранее. (Я отключил другие столбцы по соображениям конфиденциальности)

Скриншот

Первоначально электронные письма только добавлялись с какого-то случайного дня в мае 2014 года. Я удалил свою учетную запись в Outlook 2013 и заново добавил ее, и именно тогда код Excel начал захватывать ее с 14:17 сегодня, а не несколько месяцев назад. Исходя из этого, я считаю, что это как-то связано с кодом, который читает только файл PST, созданный во время привязки учетной записи к Outlook, но я не совсем уверен.

Я широко гуглил эту проблему, и, похоже, никто не сталкивался с такой же проблемой. Я просто хочу знать, есть ли способ, которым я могу изменить свой код, чтобы получать только самые последние письма. Я не хочу захватывать архивированные электронные письма, которые есть в оригинальном файле PST. Есть ли способ восстановить файл PST каждый раз, когда код выполняется? Есть ли способ, которым код может просто читать из активного окна Outlook, а не из архивного файла? Любой совет будет высоко ценится.

Вот мой код:

Sub Test()

'Dim objOL As Object
'Set objOL = CreateObject("Outlook.Application")

Dim objOL As Outlook.Application
Set objOL = New Outlook.Application

Dim OLF As Outlook.MAPIFolder
Set OLF = GetObject("", "Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)

Dim CurrUser As String
Dim EmailItem
Dim i As Integer
Dim EmailCount As Integer

Dim WS As Worksheet ' assigns variable WS to being a new worksheet
Application.ScreenUpdating = False
Set WS = Sheets.Add(After:=Sheets(Worksheets.Count)) ' creates a new worksheet
ActiveSheet.Name = "List of Received Emails" ' renames the worksheet

' adds the headers
Cells(1, 1).Formula = "From:"
Cells(1, 2).Formula = "Cc:"
Cells(1, 3).Formula = "Subject:"
Cells(1, 4).Formula = "Date"
Cells(1, 5).Formula = "Received"

With Range("A1:E1").Font ' range of cells and the font style
    .Bold = True
    .Size = 14
End With

EmailItemCount = OLF.Items.Count

i = 0
EmailCount = 0

' reads e-mail information
While i < 100
    i = i + 1
    With OLF.Items(i)
        EmailCount = EmailCount + 1
        Cells(EmailCount + 1, 1).Formula = .SenderName
        Cells(EmailCount + 1, 2).Formula = .CC
        Cells(EmailCount + 1, 3).Formula = .Subject
        Cells(EmailCount + 1, 4).Formula = Format(.ReceivedTime, "mm/dd/yyyy")
        Cells(EmailCount + 1, 5).Formula = Format(.ReceivedTime, "hh:mm AMPM")
    End With
Wend
Set OLF = Nothing
Columns("A:D").AutoFit
Range("A2").Select

Application.StatusBar = False

End Sub

PS В моей книге Excel включена ссылка на библиотеку объектов Microsoft Outlook 15.0.

Источник

1 ответ

Вы можете Restrict а также Sort Items что вы получаете... См. ссылку MSDN здесь: Items.Sort reference

Например, перед вашим циклом:

 OLF.Items.Sort "[SentOn]", True

(Истина для нисходящего...)

Источник
Другие вопросы по тегам