![](/img/trans.png)
[英]How to extract sent items from Outlook shared mailbox in Excel VBA?
[英]Extract from Shared Mailbox Outlook Subfolder is not working
我使用下面的代碼從收件箱和子文件夾/子子文件夾(如果有)中提取主題。 在我的主郵箱上工作正常,它提取了收件箱和子文件夾。
我在 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
“我嘗試這種方法‘嘗試關閉代理文件夾的緩存 - 在 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")
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.