如何将最近发送的 10 封电子邮件下载到 ms access

Posted 2023-05-07

【中文标题】如何将最近发送的 10 封电子邮件下载到 ms access

【英文标题】：How to download 10 most recent sent mails into ms access

【发布时间】：2017-08-25 05:33:52

【问题描述】：

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

您首先需要按接收时间对电子邮件进行排序。然后阅读前 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

【讨论】：

谢谢！如果你喜欢这个答案，如果你能投票，我将不胜感激