Ошибка таймера выполнения «5» при назначении Outlook Folder.items для объекта в Excel

Question

Возникают некоторые проблемы, связанные с сообщением Excel

ошибка таймера выполнения "5"

при назначении объекту Outlook Folder.items.

Это продолжение этой темы. Outlook При выборе подпапки в SharedMailbox с помощью ошибки автоматизации GetSharedDefaultFolder

После устранения ошибки автоматизации возникает ошибка времени выполнения 5, недопустимый вызов процедуры или аргумент во время выполнения кода: '' 'Задайте olItem = MyFolder.Items '' '

Может кто-нибудь, пожалуйста, помогите?!

Sub CountInboxSubjects()

    Dim olApp As Outlook.Application
    Dim olNs As Outlook.Namespace
    Dim olFldr As Outlook.MAPIFolder
    Dim MyFolder As Outlook.MAPIFolder
    Dim MyFolder1 As Outlook.MAPIFolder
    Dim MyFolder2 As Outlook.MAPIFolder
    Dim MyFolder3 As Outlook.MAPIFolder
    Dim olMailItem As Outlook.MailItem
    Dim propertyAccessor As Outlook.propertyAccessor
    Dim olItem As Object
    'Dim olItem As Outlook.Items
    Dim dic As Dictionary
    Dim i As Long
    Dim Subject As String
    Dim val1 As Variant
    Dim val2 As Variant

    val1 = ThisWorkbook.Worksheets("EPI_Data").Range("I2")
    val2 = ThisWorkbook.Worksheets("EPI_Data").Range("I3")

    Set olApp = New Outlook.Application
    Set olNs = olApp.GetNamespace("MAPI")
    'Set olFldr = olNs.GetDefaultFolder(olFolderInbox)
    Set olShareName = olNs.CreateRecipient("F0400602@email.com")
    Set olFldr = olNs.GetSharedDefaultFolder(olShareName, olFolderInbox)

    If ThisWorkbook.Worksheets("EPI_Data").Range("I5") = "Inbox" Then
        Set MyFolder = olFldr
        MsgBox (MyFolder)
    ElseIf ThisWorkbook.Worksheets("EPI_Data").Range("I5") = "Feasibilities" Then
        Set MyFolder = olFldr.Folders("Feasibilities")
        MsgBox (MyFolder)
    ElseIf ThisWorkbook.Worksheets("EPI_Data").Range("I5") = "FNC's" Then
        Set MyFolder = olFldr.Folders("Feasibilities").Folders("FNC's")
        MsgBox (MyFolder)
    ElseIf ThisWorkbook.Worksheets("EPI_Data").Range("I5") = "ISAs - Actioned" Then
        Set MyFolder = olFldr.Folders("Feasibilities").Folders("ISAs - Actioned")
        MsgBox (MyFolder)
    End If

    Set olItem = MyFolder.Items
    'Set myRestrictItems = olItem.Restrict("[ReceivedTime]>'" & Format$("01/01/2019 00:00AM", "General Date") & "' And [ReceivedTime]<'" & Format$("01/02/2019 00:00AM", "General Date") & "'")
    Set myRestrictItems = MyFolder.Items.Restrict("[ReceivedTime]>'" & Format$(val1, "General Date") & "' And [ReceivedTime]<'" & Format$(val2, "General Date") & "'")

    For Each olItem In myRestrictItems
            If olItem.Class = olMail Then
            Set propertyAccessor = olItem.propertyAccessor
            Subject = propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x0E1D001E")
            If dic.Exists(Subject) Then dic(Subject) = dic(Subject) + 1 Else dic(Subject) = 1
        End If
    Next olItem

    With ActiveSheet
        .Columns("A:B").Clear
        .Range("A1:B1").Value = Array("Count", "Subject")
        For i = 0 To dic.Count - 1
            .Cells(i + 2, "A") = dic.Items()(i)
            .Cells(i + 2, "B") = dic.Keys()(i)
        Next
    End With

End Sub

Answer 1

Используйте Dim olitems в качестве Outlook.Items или переключитесь, чтобы установить myRestrictItems = myfolder.items

свойство Items Содержит коллекцию объектов элементов Outlook в папке

---

Пример

Option Explicit
Sub CountInboxSubjects()
    Dim olApp As Outlook.Application
    Set olApp = New Outlook.Application

    Dim olNs As Outlook.Namespace
    Set olNs = olApp.GetNamespace("MAPI")

    Dim olShareName As Outlook.Recipient
    Set olShareName = olNs.CreateRecipient("email@email.com")

    Dim olFldr As Outlook.MAPIFolder
    Set olFldr = olNs.GetSharedDefaultFolder(olShareName, olFolderInbox)


    Dim myRestrictItems As Outlook.Items
    Set myRestrictItems = olFldr.Items.Restrict("[ReceivedTime]>'" & Format$(val1, "General Date") & _
                                          "' And [ReceivedTime]<'" & Format$(val2, "General Date") & "'")

    Dim olItem As Object

    Dim lng As Long
    For lng = myRestrictItems.Count To 1 Step -1

        Set olItem = myRestrictItems(lng)
        If olItem.Class = olMail Then
            Debug.Print olItem.Subject
        End If

    Next

End Sub