如何下載10個最近發送的郵件到ms訪問

Question

我使用下面給出的代碼下載發送的項目到我的訪問數據庫。雖然代碼可以工作，但它會循環處理所有發送的郵件，但是我想在執行發送的項目文件夾中最後10個項目的操作後停止循環。我知道我可以使用限制功能或做，直到但我不清楚在做它可以幫助嗎？

Private Sub sntml() 
Dim rst As DAO.Recordset 
Dim OlApp As Outlook.Application 
Dim stfldr As Outlook.MAPIFolder 
Dim stfldrItems As Outlook.Items 
Dim Mailobject As Object 
Dim db As DAO.Database 
Dim dealer As Integer 
Set db = CurrentDb 
Set OlApp = CreateObject("Outlook.Application") 
Set stfldr = OlApp.GetNamespace("Mapi").GetDefaultFolder(olFolderSentMail) 
Set rst= CurrentDb.OpenRecordset("ogmls") 
Set stfldrItems = stfldr.Items 
For Each Mailobject In stfldrItems 
    With rst 
        .AddNew 
        !Subject = Mailobject.Subject 
        !from = Mailobject.SenderName 
        !To = Mailobject.To 
        !Body = Mailobject.Body 
        !DateSent = Mailobject.SentOn 
        .Update 
        Mailobject.UnRead = False 
    End With 
End If 
Next 
Set OlApp = Nothing 
Set stfldr = Nothing 
Set stfldrItems = Nothing 
Set Mailobject = Nothing 
Set rst = Nothing 
End Sub 

Answer 1

您首先需要根據收到的時間對電子郵件進行排序。然後閱讀前10個電子郵件並完成時退出循環

Private Sub sntml() 
Dim rst As DAO.Recordset 
Dim OlApp As Outlook.Application 
Dim stfldr As Outlook.MAPIFolder 
Dim stfldrItems As Outlook.Items 
Dim Mailobject As Object 
Dim db As DAO.Database 
Dim dealer As Integer 
Dim emailCount as integer 

Set db = CurrentDb 
Set OlApp = CreateObject("Outlook.Application") 
Set stfldr = OlApp.GetNamespace("Mapi").GetDefaultFolder(olFolderSentMail) 
Set rst= CurrentDb.OpenRecordset("ogmls") 
Set stfldrItems = stfldr.Items 
stfldrItems.Sort "[ReceivedTime]" 
emailCount=1 
For Each Mailobject In stfldrItems 

    With rst 
     .AddNew 
     !Subject = Mailobject.Subject 
     !from = Mailobject.SenderName 
     !To = Mailobject.To 
     !Body = Mailobject.Body 
     !DateSent = Mailobject.SentOn 
     .Update 
     Mailobject.UnRead = False 
    End With 
    emailCount = emailCount+1 
    if emailCount > 10 then 
     Exit For 
    end if 

Next 
Set OlApp = Nothing 
Set stfldr = Nothing 
Set stfldrItems = Nothing 
Set Mailobject = Nothing 
Set rst = Nothing 
End Sub