Accessing a Shared Inbox from Outlook using Excel VBA

Question

I am trying to pull emails for a specific date range into Excel from a shared inbox in Outlook. Here is the code:

Sub getDataFromOutlook()

Dim OutlookApp As Outlook.Application
Dim OutlookNamespace As Namespace
Dim Folder As MAPIFolder
Dim OutlookMail As Variant
Dim objOwner As Outlook.Recipient
Dim i As Integer

Set OutlookApp = New Outlook.Application
Set OutlookNamespace = OutlookApp.GetNamespace("MAPI")
Set objOwner = OutlookNamespace.CreateRecipient("xxxxxx@xxxxxx.com")
objOwner.Resolve

If objOwner.Resolved Then
    Set Folder = OutlookNamespace.GetSharedDefaultFolder(objOwner, olFolderInbox)
End If

i = 1

For Each OutlookMail In Folder.Items

    If OutlookMail.ReceivedTime >= Range("email_ReceiptDate").Value Then

        Range("email_Subject").Offset(i, 0) = OutlookMail.Subject
        Range("email_Subject").Offset(i, 0).Columns.AutoFit
        Range("email_Subject").Offset(i, 0).VerticalAlignment = xlTop
        Range("email_Date").Offset(i, 0) = OutlookMail.ReceivedTime
        Range("email_Date").Offset(i, 0).Columns.AutoFit
        Range("email_Date").Offset(i, 0).VerticalAlignment = xlTop
        Range("email_Sender").Offset(i, 0) = OutlookMail.SenderName
        Range("email_Sender").Offset(i, 0).Columns.AutoFit
        Range("email_Sender").Offset(i, 0).VerticalAlignment = xlTop
        Range("email_Body").Offset(i, 0) = OutlookMail.Body
        Range("email_Body").Offset(i, 0).Columns.AutoFit
        Range("email_Body").Offset(i, 0).VerticalAlignment = xlTop

        i = i + 1

    End If

Next OutlookMail

Set Folder = Nothing
Set OutlookNamespace = Nothing
Set OutlookApp = Nothing

End Sub

Per the debugger the error is at

 If OutlookMail.ReceivedTime >= Range("email_ReceiptDate").Value Then

I ran this part of the code in a test on my inbox and it worked.

Added the

objOwner.Resolve

If objOwner.Resolved Then
    Set Folder = OutlookNamespace.GetSharedDefaultFolder(objOwner, olFolderInbox)
End If

Still getting error:

Runtime error 438
object doesn't support this property or method

What is the specific error message? Do you just have email items in this inbox, or are there meeting invites as well, for example? — BigBen, May 21 '18 at 19:55
You might want to test `If TypeOf OutlookMail Is MailItem` before you check its `ReceivedTime`. — BigBen, May 21 '18 at 20:09
Possible duplicate of [Type Mismatch in mailitem loop](https://stackoverflow.com/questions/24372849/type-mismatch-in-mailitem-loop) — niton, May 22 '18 at 22:42

score 0 · Accepted Answer · answered May 22 '18 at 13:58

0

Based on the specific error, I'm guessing that not all the Items in your shared inbox are MailItems - only a MailItem has a ReceivedTime.

I'd revise your For loop:

For Each OutlookMail In Folder.Items

    If TypeOf OutlookMail Is MailItem Then
       If OutlookMail.ReceivedTime >= Range("email_ReceiptDate").Value Then
           ' rest of your code
       End If
    End If

Next OutlookMail

answered May 22 '18 at 13:58

BigBen

46,229
7
24
40

is it possible you can help me with another question? https://stackoverflow.com/q/50470916/9824852 – Rhea May 22 '18 at 15:05
I'd copy your existing code here into that new question - that way everyone can follow what you want to do. – BigBen May 22 '18 at 15:16
I am trying to automate filling in my excel sheet at the next empty row. I am new to VBA so forgive me for having a lot of questions. So far I am able to find the next empty row and return it in a message box. Sub nextEmptyRow() 'finds the next empty row eRow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row 'displays the row number in message pop up MsgBox eRow End Sub What I want is not only to find the next empty row but to be able to run my macro for GetDataFromOutlook() and have it populate starting at that next empty spot – Rhea May 22 '18 at 15:37
Yes I read your question. I'm assuming you have headers in the ranges "Email_Subject", "Email_Date", etc. (?) If so, instead of using `i` to Offset, you could do something like `Cells(Rows.Count, Range("email_Subject").Column).End(xlUp).Offset(1)` instead of `Range("email_Subject").Offset(i, 0)`. – BigBen May 22 '18 at 15:53
1

As a side note, do not loop through all items in a folder - use Items.Restrcit or Items.Find/FindNext to search on "[ReceivedTime] > 'some value'" – Dmitry Streblechenko May 23 '18 at 19:35

Accessing a Shared Inbox from Outlook using Excel VBA

1 Answers1