最近アクセスした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