从Outlook导入最新的电子邮件到Excel（VBA）

我花了很多时间研究这个，我还没有找到完整的答案 . 我要做的是从Outlook获取最近的100封电子邮件，并将它们粘贴到Excel工作簿中 . 我已经构建了一个代码（从几个不同的网站借用）已经完成了，但它缺少“最新”部分 .

当我在Excel中执行此代码时，将打印出101行，其中包含我指定的信息，这是好的 . 但它不是最近的电子邮件 . 如果您在下图中看到，现在的时间是晚上7:18，但导入Excel的电子邮件仅在今天和之前的下午2:17 . （出于隐私原因，我将其他栏目涂黑了）

最初，这些电子邮件只是在2014年5月的某个随机日子里粘贴 . 我在Outlook 2013上删除了我的帐户并重新添加了它，这就是当Excel代码从今天下午2:17开始抓取它而不是几个月之前 . 基于此，我认为这与代码只是读取帐户链接到Outlook时创建的PST文件有关，但我不完全确定 .

我广泛搜索过这个问题，似乎没有人遇到同样的问题 . 我只是想知道是否有一种方法可以修改我的代码以仅获取最近的电子邮件 . 我不想抓取原始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

附：我在Excel工作簿中启用了Microsoft Outlook 15.0对象库引用 .