从未读电子邮件中复制数据并标记为已读

Question

我想将 Outlook RSS 源中的“未读电子邮件”复制到 Excel。这些复制的电子邮件应在 Outlook 中标记为“已读”。

下面的代码返回

无效的过程调用或参数。

Private Sub run_btn_Click()
    Dim OutlookApp As Outlook.Application
    Dim OutlookNamespace As Namespace
    Dim Folder As MAPIFolder
    Dim OutlookMail As Variant

    Dim i As Integer

    Set OutlookApp = New Outlook.Application
    Set OutlookNamespace = OutlookApp.GetNamespace("MAPI")
    Set Folder = OutlookNamespace.GetDefaultFolder(olfolderrssfeeds).Folders("Folder Name")

    If Folder.items.Restrict("[UnRead] = True").Count = 0 Then
        MsgBox "No Unread email", vbInformation, "Congratulation!"
    End If

    i = 1

    For Each OutlookMail In Folder.items.Restrict("[UnRead] = True")
        Range("eMail_subject").Offset(i, 0).Value = Left(OutlookMail.Subject, 11)
        Range("eMail_date").Offset(i, 0).Value = OutlookMail.ReceivedTime
        Range("eMail_text").Offset(i, 0).Value = OutlookMail.Body        
        i = i + 1
    Next OutlookMail

    If Folder.items.Restrict("[Unread] = True") Then
        Folder.items.UnRead = False
        Folder.items.Save
    End If

    Set Folder = Nothing
    Set OutlookNamespace = Nothing
    Set OutlookApp = Nothing
End Sub

Answer 1

我无法重现您看到的确切错误，而且我不知道错误在哪里。但是，以下对我有用，从 Excel 2013 运行以控制 Outlook 2013。请参阅<== 标记。

Option Explicit    ' <== Always include this at the top of every module

Private Sub run_btn_Click()
    Dim OutlookApp As Outlook.Application
    Dim OutlookNamespace As Namespace
    Dim Folder As MAPIFolder
    Dim OutlookMail As Object   ' <== Doesn't need to be Variant

    Dim rowIndex As Integer     ' <== rename from `i` to `rowIndex` for clarity

    Set OutlookApp = New Outlook.Application
    Set OutlookNamespace = OutlookApp.GetNamespace("MAPI")
    Set Folder = OutlookNamespace.GetDefaultFolder(olFolderRssFeeds)        ' <==
        ' After you call GetDefaultFolder, you already have a folder - you don't
        ' need to call .Folder() on it.

    If Folder.UnReadItemCount = 0 Then      ' <== Don't need to use Restrict for unread-item count
        MsgBox "No Unread email", vbInformation, "Congratulation!"
    End If

    rowIndex = 1

    For Each OutlookMail In Folder.Items.Restrict("[UnRead] = True")
        Range("eMail_subject").Offset(rowIndex, 0).Value = Left(OutlookMail.Subject, 11)
        Range("eMail_date").Offset(rowIndex, 0).Value = OutlookMail.ReceivedTime
        Range("eMail_text").Offset(rowIndex, 0).Value = OutlookMail.Body

        MarkItemReadIfEmail OutlookMail     ' <== Mark each one read as it's processed

        rowIndex = rowIndex + 1
    Next OutlookMail

    'If Folder.UnReadItemCount > 0 Then     ' <== already did this in the loop above
    '    Folder.Items.UnRead = False        '     so don't need to do it here.
    '    Folder.Items.Save
    'End If

    Set Folder = Nothing
    Set OutlookNamespace = Nothing
    Set OutlookApp = Nothing
End Sub

Private Sub MarkItemReadIfEmail(obj As Object)
    Dim mail As PostItem    ' **Edit** - was originally MailItem

    ' Find out if it's a mail item
    Set mail = Nothing
    On Error Resume Next
    Set mail = obj
    On Error GoTo 0

    If mail Is Nothing Then Exit Sub

    ' It's an email, so mark it.
    mail.UnRead = False
    mail.Save
End Sub

Sub MarkItemReadIfEmail 是一种将电子邮件标记为已读的谨慎方式。实际上，我对 Outlook 对象模型的了解还不够，无法知道 Folder.Items 总是为 RSS-feed 文件夹返回 edit PostItem。因此，在将每个项目视为PostItem 之前，我会检查它是否真的是一个。