Как ссылаться на подпапку в общем почтовом ящике Outlook VBA

Question

Я работаю над сценарием, который сохраняет вложения Outlook на общий диск.

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

Как мне изменить приведенный ниже код для достижения этой цели?

Private WithEvents InboxItems As Outlook.Items
    Const attPath As String = "T:\London File3 Group\Client Reporting\Test\ABI Daily\"

    Private Sub Application_Startup()
    Dim outlookApp As Outlook.Application: Set outlookApp = Outlook.Application
    Dim objectNS As Outlook.NameSpace: Set objectNS = outlookApp.GetNamespace("MAPI")
    Set InboxItems = objectNS.GetDefaultFolder(olFolderInbox).Items
End Sub

Private Sub InboxItems_ItemAdd(ByVal Item As Object)
    Dim Msg             As Outlook.MailItem: Set Msg = Item
    Dim olDestFldr      As Outlook.MAPIFolder
    Dim myAttachments   As Outlook.Attachments
    Dim Filename        As String

    If Not TypeName(Msg) = "MailItem" Then Exit Sub
    If (Msg.Subject Like "*Trade*") Or (Msg.Subject Like "*Trades*") Or (Msg.Subject Like "*Article 59*") Or (Msg.Subject Like "*Val*") Or (Msg.Subject Like "*Valuation*") Or (Msg.Subject Like "*Trading*") Or (Msg.Subject Like "*St James*") Then

    Set myAttachments = Item.Attachments
       Filename = myAttachments.Item(1).DisplayName
        myAttachments.Item(1).SaveAsFile attPath & Filename
        Msg.UnRead = False
    End If
End Sub

Answer 1

Работа с Метод GetSharedDefaultFolder , который возвращает объект MAPIFolder, представляющий указанную папку по умолчанию для указанного пользователя. Этот метод используется в сценарии делегирования, когда один пользователь делегировал доступ другому пользователю для одной или нескольких папок по умолчанию

Пример

Private WithEvents InboxItems As Outlook.Items
Const attPath As String = "T:\London File3 Group\Client Reporting\Test\ABI Daily\"

Private Sub Application_Startup()
    Dim outlookApp As Outlook.Application: Set outlookApp = Outlook.Application
    Dim objectNS As Outlook.NameSpace: Set objectNS = outlookApp.GetNamespace("MAPI")
    Dim ShrdRecip As Outlook.Recipient: Set ShrdRecip = objectNS.CreateRecipient("0m3r@email.com")

    Set InboxItems = GetSharedDefaultFolder(ShrdRecip, olFolderInbox).Items
End Sub

Редактировать

Пример подпапки

Private WithEvents Items As Outlook.Items
Private Sub Application_Startup()
    Dim olNs As Outlook.NameSpace
    Dim ShrdRecip As Outlook.Recipient
    Dim Inbox  As Outlook.MAPIFolder

    Set olNs = Application.GetNamespace("MAPI")
    Set ShrdRecip = olNs.CreateRecipient("0m3r@email.com")
    Set Inbox = olNs.GetSharedDefaultFolder(ShrdRecip, olFolderInbox) _
                                                .Folders("FolderName")
    Set Items = Inbox.Items
End Sub

Private Sub Items_ItemAdd(ByVal Item As Object)
    If TypeOf Item Is Outlook.MailItem Then
        Debug.Print Item.Subject ' print on Immediate window
    End If
End Sub