如何将10个最近发送的邮件下载到ms访问

时间:2017-08-25 05:33:53

标签: ms-access outlook-vba

我使用下面给出的代码将发送的项目下载到我的访问数据库中。虽然代码工作,但它会循环遍历所有已发送的邮件,但我想在发送的items项目文件夹中的最后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

1 个答案:

答案 0 :(得分: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