Скопируйте электронную почту из Outlook и помечены как прочитанные

Question

Я хочу скопировать эти «непрочитанные электронные письма» из RSS-каналов Outlook, чтобы преуспеть, и когда это будет сделано, эти скопированные электронные письма должны помечаться как «Чтение» в 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 всегда возвращает edit PostItem для папок RSS-ленты. Поэтому, прежде чем рассматривать каждый элемент как PostItem, я проверяю, действительно ли он равен единице.