Import Most Recent Emails from Outlook Into Excel

[safafariix3]

Hi all,

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:35 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)

http://s30.postimg.org/q0f0ityy9/Excel_VBA.png

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

Thank you so much!

 

[AlphaFrog]

Try this...

[COLOR=darkblue]Sub[/COLOR] Test()
        
    [COLOR=darkblue]Dim[/COLOR] OLF [COLOR=darkblue]As[/COLOR] Outlook.MAPIFolder
    [COLOR=darkblue]Set[/COLOR] OLF = GetObject("", "Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
    
    [COLOR=darkblue]Dim[/COLOR] CurrUser [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR]
    [COLOR=darkblue]Dim[/COLOR] EmailItem
    [COLOR=darkblue]Dim[/COLOR] i [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Integer[/COLOR], iStart [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Integer[/COLOR], iEnd [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Integer[/COLOR]
    [COLOR=darkblue]Dim[/COLOR] EmailCount [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Integer[/COLOR]
    
    Sheets.Add After:=Sheets(Worksheets.Count) [COLOR=green]' creates a new worksheet[/COLOR]
    ActiveSheet.Name = "List of Received Emails" [COLOR=green]' renames the worksheet[/COLOR]
    
    [COLOR=green]' adds the headers[/COLOR]
    [COLOR=darkblue]With[/COLOR] Range("A1:E1")
        .Value = Array("From:", "Cc:", "Subject:", "Date", "Received")
        .Font.Bold = [COLOR=darkblue]True[/COLOR]
        .Font.Size = 14
    [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
    
    iStart = 1
    iEnd = OLF.Items.Count
    [COLOR=darkblue]If[/COLOR] iEnd > 100 [COLOR=darkblue]Then[/COLOR] iStart = iEnd - 99    [COLOR=green]'start at the last 100 mail items[/COLOR]
    
    [COLOR=green]' reads e-mail information[/COLOR]
    [COLOR=darkblue]For[/COLOR] i = iStart [COLOR=darkblue]To[/COLOR] i[COLOR=darkblue]End[/COLOR]
        [COLOR=darkblue]With[/COLOR] 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")
        [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
    [COLOR=darkblue]Next[/COLOR] i
    
    [COLOR=darkblue]Set[/COLOR] OLF = [COLOR=darkblue]Nothing[/COLOR]
    Columns("A:D").AutoFit
    Range("A2").Select
    Application.StatusBar = [COLOR=darkblue]False[/COLOR]
        
End [COLOR=darkblue]Sub[/COLOR]

 

[safafariix3]

Try this...

AlphaFrog, thank you so much for your response. I appreciate your taking the time to look into this.

So, I tried out your code. The result was very interesting. Here is a screenshot:

So, I indeed got 100 rows of emails, and your code miraculously got the most recent emails in my Inbox at the bottom-most rows there (which is great because that's the part I was struggling with), but something funny happens in the Date column. If you notice, some of the emails are 12/27/2014 and then they cut off to 12/27/2013.

I just noticed as well that in rows 89, 90, 91, and 92 the times are:

[TABLE="width: 64"]
<colgroup><col width="64" style="width:48pt"> </colgroup><tbody>[TR]
[TD="class: xl63, width: 64, align: right"]4:14 PM[/TD]
[/TR]
[TR]
[TD="class: xl63, align: right"]4:10 PM[/TD]
[/TR]
[TR]
[TD="class: xl63, align: right"]3:41 PM[/TD]
[/TR]
[TR]
[TD="class: xl63, align: right"]5:29 PM[/TD]
[/TR]
</tbody>[/TABLE]

5:29 PM should be at the top, but it is at the bottom and all of the emails below the row with 5:29 are in the correct order.

Also, the funny thing is the "2014" emails seemed to show only the emails that came in after the 2:17 PM mark in my original code that I could not get beyond. Here is what I mean:

So, your code got me all of the emails that came in after 2:17 PM, and my code gave me all of the emails that were prior to 2:17 PM. This is pretty interesting. Do you have any thoughts on how to combine the two?

Thanks so much!

 

[safafariix3]

5:29 PM should be at the top, but it is at the bottom and all of the emails below the row with 5:29 are in the correct order.

Edit: I noticed that the rest are a bit scattered (the last two rows 10:01 PM is on top of 9:49 PM) as well. That might just have to do with the way the Sort is configured in the code though.

 

[AlphaFrog]

Did you import the emails from another source or email program or another computer?

The emails listed in the inbox are in the order they where received (index #) in Outlook. If you imported the emails, they may have been reordered differently than their original Date-Time stamp. I'm just speculating. I really have no idea.

 

[safafariix3]

Did you import the emails from another source or email program or another computer?

The emails listed in the inbox are in the order they where received (index #) in Outlook. If you imported the emails, they may have been reordered differently than their original Date-Time stamp. I'm just speculating. I really have no idea.

As far as programs, I only use Excel and Outlook. I will use Web Mail sometimes too but I can't import from there. Multiple people connect to this email inbox, but the Excel workbook is only accessed by me (for now). But the other folks that sign into the email account all have their own Outlook application.

Yes, the sorting will seemingly be easy to fix I think. I am just stumped on the actual retrieval and trying to get all of the correct emails pasted over.

 

[AlphaFrog]

I suppose you could import all the emails. Sort the rows in Excel by date-time ascending. Then delete the bottom rows beyond row 101.