Как получить тело письма из общей папки?

Question

Следующий код помогает мне получить данные из папки по умолчанию в папке «Входящие», но я хочу изменить свою папку, которая является общей папкой и помещена в избранные папки

Я уже пытался изменить getDefaultFolder с помощью sharedDefaultFolder но это не работает.

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

Вы не можете просто изменить GetDefaultFolder на GetSharedDefaultFolder , вы также должны добавить объект получателя Владелец папки.

выражение: .GetSharedDefaultFolder(Recipient**, FolderType)

Пример с адресом электронной почты

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

Или, если вы используете Только имя, убедитесь, что объект получателя разрешен

Пример с именем получателя

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

Answer 2

Дает ли ваша фраза "set olFldr ..." правильную папку?

Вы можете проверить свои папки с помощью следующего утверждения:

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