Outlook При выборе вложенной папки в SharedMailbox с помощью ошибки автоматизации GetSharedDefaultFolder

Question

Следующий код предназначен для подсчета количества электронных писем в конкретном SharedMailbox или subfolder.

У меня проблемы с выбором подпапки в SharedMailbox. Я прочитал несколько ресурсов о GetSharedDefaultFolder, включая этот .

Однако, изо всех сил пытаясь собрать его правильно. Было бы здорово, если бы вы могли помочь с этим.

При выполнении кода возникает следующая ошибка.

Ошибка времени выполнения '-2147221233 (80040010f)' Ошибка автоматизации

Sub CountInboxSubjects()

    Dim olApp As Outlook.Application
    Dim olNs As Outlook.Namespace
    Dim olFldr 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 dic As Dictionary
    Dim i As Long
    Dim Subject As String
    Dim val1 As Variant
    Dim val2 As Variant

    val1 = ThisWorkbook.Worksheets("Data").Range("I2")
    val2 = ThisWorkbook.Worksheets("Data").Range("I3")

    Set olApp = New Outlook.Application
    Set olNs = olApp.GetNamespace("MAPI")
    'Set olFldr = olNs.GetDefaultFolder(olFolderInbox)
    Set olShareName = olNs.CreateRecipient("Shared_MailBox")
    Set olFldr = olNs.GetSharedDefaultFolder(olShareName, olFolderInbox)
    MsgBox (olFldr)

    Set MyFolder1 = olFldr.Folders("Sub_Folder")
    MsgBox (MyFolder1)
    Set MyFolder2 = MyFolder1.Folders("Sub_Sub_Folder")
    MsgBox (MyFolder2)
    Set MyFolder3 = MyFolder1.Folders("Sub_Sub_Folder2")
    MsgBox (MyFolder3)


    If ThisWorkbook.Worksheets("EPI_Data").Range("I5") = "Inbox" Then
        MyFolder = olFldr
    ElseIf ThisWorkbook.Worksheets("EPI_Data").Range("I5") = "Sub_Folder" Then
        MyFolder = MyFolder1
    ElseIf ThisWorkbook.Worksheets("EPI_Data").Range("I5") = "Sub_Sub_Folder" Then
        MyFolder = MyFolder2
    ElseIf ThisWorkbook.Worksheets("EPI_Data").Range("I5") = "Sub_Sub_Folder" Then
        MyFolder = MyFolder3
    End If

    Set olItem = MyFolder.Items
    '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

После устранения неполадок я знаю, что у следующего шага есть проблемы:

Set MyFolder1 = olFldr.Folders("Sub_Folder")
MsgBox (MyFolder1)

Я ожидаю, что msgbox вернет имя подпапки, но сообщит об ошибке.

Ошибка времени выполнения '-2147221233 (80040010f)' Ошибка автоматизации

Я не мог понять, почему. может кто-нибудь, пожалуйста, помогите ..

Answer 1

Конечно, вы должны сопоставить имя или адрес получателя с адресной книгой, прежде чем обращаться к общим папкам.

    Set olApp = New Outlook.Application
    Set olNs = olApp.GetNamespace("MAPI")    
    Set olShareName = olNs.CreateRecipient("Shared_MailBox")
    olShareName.Resolve
    If Recip.Resolved Then
       Set olFldr = olNs.GetSharedDefaultFolder(olShareName, olFolderInbox)
       ...
    End If

Но причина проблемы с доступом к подпапке другая ...

Прежде всего, попробуйте снять флажок Download shared folders, установленный в Advanced tab диалогового окна свойств учетной записи Exchange. Для получения дополнительной информации см. Определение, если в Outlook установлен флажок «Загружать общие папки».

Во-вторых, ознакомьтесь с . По умолчанию общие почтовые папки загружаются вКэшированный режим в Outlook 2010 и Outlook 2013 статья. Какое значение вы установили для клавиши CacheOthersMail на ПК?

См. Доступ к подпапкам в общем почтовом ящике для получения дополнительной информации.

Answer 2

Попробуйте поработать с адресом электронной почты получателя, если имя получателя, то попробуйте разрешить Получатель по адресной книге ...

---

Option Explicit
Public Sub Example()
    Dim olApp As Outlook.Application
    Set olApp = CreateObject("Outlook.Application")

    Dim olNs As Outlook.Namespace
    Set olNs = olApp.GetNamespace("MAPI")

    Dim Recip As Outlook.Recipient
    Dim Inbox As Outlook.MAPIFolder

    Set Recip = olNs.CreateRecipient("0m3r@Email.com")
    Recip.Resolve

    If Recip.Resolved Then
        Set Inbox = olNs.GetSharedDefaultFolder _
                            (Recip, olFolderInbox)
    End If        

    Inbox.Display

End Sub