Извлечение из общего почтового ящика в подпапке Outlook не работает

Question

Я использую этот код ниже, чтобы извлечь темы из папок «Входящие» и «Подпапки / подпапки», если таковые имеются. Работает нормально на моем основном почтовом ящике, где он извлек INBOX и SubFolders.

У меня мало общих почтовых ящиков в Outlook. Когда я пытаюсь вызвать общий почтовый ящик, он извлекает только общий почтовый ящик INBOX, но не вложенные папки.

Что-то не так с моими кодами? Или что-нибудь добавлю?

Public xlSht As Excel.Worksheet

Sub DocumentFolders(objParent As Folder, lRow As Long)
Dim objItm As Object
Dim objFolder As Folder

    On Error Resume Next
    With xlSht
        For Each objItm In objParent.Items
            .Cells(lRow, 1) = objParent
            .Cells(lRow, 2) = objItm.Subject
            .Cells(lRow, 3) = objItm.ReceivedTime
            lRow = lRow + 1
        Next
    End With
    On Error GoTo 0

    If objParent.Folders.Count > 0 Then
        For Each objFolder In objParent.Folders
            Call DocumentFolders(objFolder, lRow)
        Next
    End If

End Sub


Sub ExportInformation()
Dim xlApp As Excel.Application
Dim xlWb As Excel.Workbook

  Dim Ns As Outlook.Namespace
  Dim olShareName As Outlook.Recipient

  Set outlookApp = New Outlook.Application
  Set Ns = outlookApp.GetNamespace("MAPI")

  Set olShareName = Ns.CreateRecipient("xxxxx@xxx.com") '// Owner's email address
  olShareName.Resolve
  Set objParent = Ns.GetSharedDefaultFolder(olShareName, olFolderInbox) '// Inbox

    Set xlApp = New Excel.Application
    Set xlWb = xlApp.Workbooks.Add
    Set xlSht = xlWb.Sheets(1)

    With xlSht
        .Cells(1, 1) = "Folder"
        .Cells(1, 2) = "Subject"
        .Cells(1, 3) = "Received Time"
    End With

     Call DocumentFolders(Session.GetSharedDefaultFolder(olShareName, olFolderInbox), 2)

    xlApp.Visible = True


Set xlSht = Nothing
Set xlWb = Nothing
Set xlApp = Nothing

End Sub

Answer 1

"Я пытаюсь использовать этот метод" Попробуйте отключить кэширование для папок делегатов - снимите флажок "Загрузить общие папки" на вкладке "Дополнительно" в диалоговом окне свойств учетной записи Exchange. ' Но это навсегда, а через некоторое время повиснет ". Как настроить вложенные папки Outlook в общей папке по умолчанию в VBA?

Попробуйте освободить память.

Sub DocumentFolders(objParent As Folder, lRow As Long, xlSht As Excel.Worksheet)

    ' ...

            lRow = lRow + 1

            ' apparently objItm is not replaced in memory by the next objItm
            ' releasing this memory in the loop may help keep Excel from hanging
            Set objItm = Nothing

        Next

    ' ...

Если этого недостаточно, уменьшите количество обрабатываемых папок. в бегах.

Set objParent = Ns.GetSharedDefaultFolder(olShareName, olFolderInbox) '// Inbox
Set objParent = objParent.folders("name of any subfolder one level under inbox")