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运行以控制Outlook2013。请参见<==标记。

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文件夹返回编辑 PostItem。因此，在将每个项目视为PostItem之前，我先检查它是否实际上是一个项目。

从Outlook复制电子邮件并标记为已读

1 个答案: