如何从共享文件夹中获取电子邮件正文？

Question

The following code helps me to get data from my default folder in inbox but I want to change my folder which is a shared folder and placed in favorite folders

I already tried to change getDefaultFolder with sharedDefaultFolder but it doesn't work.

Dim olApp As Object
Dim olNs As Object

Dim olFldr As Object
Dim olItms As Object
Dim olMail As Object

Set olApp = OutlookApp()
Set olNs = olApp.GetNamespace("MAPI")
Set olFldr = olNs.GetDefaultFolder(6).Folders("impMail")
Set olItms = olFldr.Items

Answer 1

Does your satement " set olFldr ..." give you the correct folder?

You might check your folders with a statement like:

for each myO in olNs.GetDefaultFolder(6).folders : debug.Print myO.name : next

Answer 2

You cannot simply change GetDefaultFolder to GetSharedDefaultFolder , you have to also add Recipient object The owner of the folder.

expression: .GetSharedDefaultFolder(Recipient**, FolderType)

Example With Email address

Option Explicit
Public Sub Example()
    Dim olNs As Outlook.NameSpace
    Set olNs = Application.GetNamespace("MAPI")

    Dim RecipientShareName As Outlook.Recipient
    Set RecipientShareName = olNs.CreateRecipient("0m3r@email.com") 'address
        RecipientShareName.Resolve

    Dim ShareInbox As Outlook.Folder
    Set ShareInbox = olNs.GetSharedDefaultFolder(RecipientShareName, _
                                                 olFolderInbox) 'Inbox


    Dim Items As Outlook.Items
    Set Items = ShareInbox.Items

    Dim i As Long
    Dim Item As Outlook.MailItem


    For i = Items.Count To 1 Step -1

        If TypeOf Items(i) Is Outlook.MailItem Then
            Set Item = Items(i)
            Debug.Print Item.Subject '// Print Item to Immediate window
        End If

    Next

End Sub

Or if your using With just Name, then make sure recipient object is resolved

Example with recipient Name

Option Explicit
Public Sub Example()
    Dim olNs As Outlook.NameSpace
    Set olNs = Application.GetNamespace("MAPI")

    Dim RecipientShareName As Outlook.Recipient
    Set RecipientShareName = olNs.CreateRecipient("0m3r") 'address
        RecipientShareName.Resolve

    If Not RecipientShareName.Resolved Then
        MsgBox "Error on Recipient Object"
        Exit Sub
    Else
        Dim ShareInbox As Outlook.Folder
        Set ShareInbox = olNs.GetSharedDefaultFolder(RecipientShareName, _
                                                     olFolderInbox) 'Inbox
    End If


    Dim Items As Outlook.Items
    Set Items = ShareInbox.Items

    Dim i As Long
    Dim Item As Outlook.MailItem


    For i = Items.Count To 1 Step -1

        If TypeOf Items(i) Is Outlook.MailItem Then
            Set Item = Items(i)
            Debug.Print Item.Subject '// Print Item to Immediate window
        End If

    Next

End Sub