Import Most Recent Emails from Outlook Into Excel (VBA)

Question

I have spent a lot of time looking into this, and I am yet to find the complete answer. What I am looking to do is grab the 100 most recent emails from Outlook and have them pasted into an Excel workbook. I have built a code (which borrows from a few different websites) that has accomplished that, but it is missing the " most recent " part.

When I execute this code in Excel, 101 rows are printed out with the information I have specified which is good. But it is not with the most recent emails. If you see in the image below, the time right now is 7:18 PM but the emails that are imported into Excel are only from 2:17 PM today and prior. (I blacked out the other columns for privacy reasons)

Originally, the emails were only pasting in from some random day in May 2014. I deleted my account on Outlook 2013 and re-added it, and that's when the Excel code started grabbing it from 2:17 PM today rather than several months ago. Based off of that, I believe this has something to do with the code only reading the PST file that is created at the time of which the account is linked to Outlook but I am not completely sure.

I have Googled this issue extensively, and no one seems to be experiencing the same issue. I just want to know if there is a way I can modify my code to grab only the most RECENT emails. I don't want to grab archived emails that are there in the original PST file. Is there a way to rebuild the PST file every time the code is executed? Is there a way the code can just read from the active Outlook window and not the archived file? Any advice will be much appreciated.

Here's my code:

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 I do have the Microsoft Outlook 15.0 Object Library reference enabled in my Excel workbook.

Answer 1

You can Restrict and Sort the Items that you get... See the MSDN reference here: Items.Sort reference

For example, before your loop:

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

(The True is for descending...)