從Outlook導入最新電子郵件到Excel（VBA）

Question

我已經花了很多時間研究這個問題，但尚未找到完整的答案。 我要做的是從Outlook中獲取100封最新電子郵件，並將其粘貼到Excel工作簿中。 我已經建立了一個代碼（該代碼是從一些不同的網站借來的）可以達到這一目的，但是它缺少“ 最新 ”部分。

當我在Excel中執行此代碼時，將打印出101行，其中包含我指定的信息，這是很好的信息。 但是最近的電子郵件卻沒有。 如果您在下圖中看到，現在的時間是7:18 PM，但是導入到Excel中的電子郵件僅是今天及之前的2:17 PM。 （出於隱私原因，我將其他列塗黑了）

最初，這些電子郵件只是在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

PS我在Excel工作簿中啟用了Microsoft Outlook 15.0對象庫參考。

Answer 1

您可以Restrict和Sort所獲得的Items ...請在此處查看MSDN參考： Items.Sort參考

例如，在循環之前：

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

（真實是為了下降...）