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

lyric025

New Member
Joined
Oct 14, 2019
Messages
3
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?!

Code:
' 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
 

Excel Facts

How to show all formulas in Excel?
Press Ctrl+` to show all formulas. Press it again to toggle back to numbers. The grave accent is often under the tilde on US keyboards.
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.
 
Upvote 0
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
 
Upvote 0
Hello lyric025,

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


 
Upvote 0
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
 
Upvote 0

Forum statistics

Threads
1,223,900
Messages
6,175,276
Members
452,629
Latest member
SahilPolekar

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top