从共享邮箱 Outlook 子文件夹中提取的内容不起作用

Question

我使用下面的代码从收件箱和子文件夹/子子文件夹（如果有）中提取主题。 在我的主邮箱上工作正常，它提取了收件箱和子文件夹。

我在 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 帐户属性对话框的高级选项卡上取消选中“下载共享文件夹”复选框。’ 但它需要永远，并在一段时间后挂起。” 如何在 VBA 中设置共享默认文件夹的 Outlook 子文件夹？

尝试释放内存。

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")