VBA count number of emails in Outlook folder/subfolders, rumtime error 5

[lyric025]

I am experiencing some issues that Excel reporting

run-timer error "5"
​

when assigning Outlook <code style="margin: 0px; padding: 1px 5px; border: 0px; font-style: inherit; font-variant: inherit; font-weight: inherit; font-stretch: inherit; line-height: inherit; font-family: Consolas, Menlo, Monaco, "Lucida Console", "Liberation Mono", "DejaVu Sans Mono", "Bitstream Vera Sans Mono", "Courier New", monospace, sans-serif; font-size: 13px; vertical-align: baseline; box-sizing: inherit; background-color: rgb(239, 240, 241); white-space: pre-wrap;">Folder.items</code> to object.
I am experiencing run time error 5, Invalid procedure call or argument while running code: '''Set olItem = MyFolder.Items'''
can anyone please help?!

' Requires Tools-->References-->Microsoft Outlook 15.0 Object Library
' Requires Tools-->References-->Microsoft Scripting Runtime
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("abcdef@gmail.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") = "Sub_Folder" Then
        Set MyFolder = olFldr.Folders("Sub_Folder")
        MsgBox (MyFolder)
    ElseIf ThisWorkbook.Worksheets("EPI_Data").Range("I5") = "Sub_Sub_Folder" Then
        Set MyFolder = olFldr.Folders("Sub_Folder").Folders("Sub_Sub_Folder")
        MsgBox (MyFolder)
    ElseIf ThisWorkbook.Worksheets("EPI_Data").Range("I5") = "Sub_Sub_Folder" Then
        Set MyFolder = olFldr.Folders("Sub_Folder").Folders("Sub_Sub_Folder")
        MsgBox (MyFolder)
    End If
        
    Set olItem = MyFolder.Items
    MsgBox (olItem)
    '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 = olItem.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

 

[Leith Ross]

Hello lyric025,

You have set your object variable olItem to the Items collection object. You will need to use an index to return a single item from the collection. You can not display the full collection at once with MsgBox, it will error.

 

[lyric025]

Thanks Ross.
I have removed the MSGBOX, following error shown:

Run-time error 91, Object variable or with block variable not set.

I believe is highlighted line reporting error....

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

 

[Leith Ross]

Hello lyric025,

Did you load the Scripting Runtime Library in your VBA References?

 

[lyric025]

Hello lyric025,

Did you load the Scripting Runtime Library in your VBA References?

yes, I have loaded following reference:

• Scripting Runtime Library
  
• Microsoft Outlook 15.0 Object Library
• Microsoft Office 15.0 Object Library
• Microsoft Excel 15.0 Object Library
• OLE Automation
• VB for Applications