Outlook access shared inbox sub-folder

问题:

I have a strange issue on the below code I use for extracting Outlook email information into Excel. Sometimes the code works perfectly but other times I get the Run-Time Error '-2147221233 (8004010f)'. When I do get this error it is the line Set objFolder = objMailbox.Folders("Inbox").Folders("ARCHIVE") that has the issue.

I am running the code on a shared inbox and I have the "ARCHIVE" folder as a sub-folder of the inbox. It is as if the code cannot find the folder even though it is there and it can find it sometimes.

My uneducated guess is that, since a shared inbox can have a delay updating across all users, if there is any action in the folder the code cannot recognize the folder until it refreshes or updates on the server.

Can anybody suggest slightly different code so that it will run every time? Or does anybody have an explanation as to why it only occasionally works as is?

Sub EmailStatsV3() 'Working macro for exporting specific sub-folders of a shared inbox Dim olMail As Variant Dim aOutput() As Variant Dim lCnt As Long Dim xlApp As Excel.Application Dim xlSh As Excel.Worksheet Dim flInbox As Folder  'Gets the mailbox and shared folder inbox Dim myNamespace As Outlook.NameSpace Dim myRecipient As Outlook.Recipient Set myNamespace = Application.GetNamespace("MAPI") Set myRecipient = myNamespace.CreateRecipient("Operations")   Set objOutlook = CreateObject("Outlook.Application") Set objNamespace = objOutlook.GetNamespace("MAPI") Set objInbox = objNamespace.GetSharedDefaultFolder(myRecipient, olFolderInbox)  'Uses the Parent of the Inbox to specify the mailbox strFolderName = objInbox.Parent  'Specifies the folder (inbox or other) to pull the info from Set objMailbox = objNamespace.Folders(strFolderName) Set objFolder = objMailbox.Folders("Inbox").Folders("ARCHIVE") 'Change this line to specify folder Set colItems = objFolder.Items  'Specify which email items to extract ReDim aOutput(1 To objFolder.Items.Count, 1 To 10) For Each olMail In objFolder.Items If TypeName(olMail) = "MailItem" Then          lCnt = lCnt + 1         aOutput(lCnt, 1) = olMail.SenderEmailAddress 'Sender or SenderName also gives similar output         aOutput(lCnt, 2) = olMail.ReceivedTime 'stats on when received         aOutput(lCnt, 3) = olMail.ConversationTopic 'group based on subject w/o regard to prefix         aOutput(lCnt, 4) = olMail.Subject 'to split out prefix         aOutput(lCnt, 5) = olMail.Categories 'to split out category         aOutput(lCnt, 6) = olMail.Sender         aOutput(lCnt, 7) = olMail.SenderName         aOutput(lCnt, 8) = olMail.To         aOutput(lCnt, 9) = olMail.CC         aOutput(lCnt, 10) = objFolder.Name End If  Next  'Creates a blank workbook in excel then inputs the info from Outlook Set xlApp = New Excel.Application Set xlSh = xlApp.Workbooks.Add.Sheets(1)  xlSh.Range("A1").Resize(UBound(aOutput, 1), UBound(aOutput, 2)).Value = aOutput xlApp.Visible = True   End Sub 

回答1:

I am assuming you are running the code from Outlook, see the cleanup I did.

Option Explicit Sub EmailStatsV3()     Dim Item As Object     Dim varOutput() As Variant     Dim lngcount As Long     Dim xlApp As Excel.Application     Dim xlSht As Excel.Worksheet     Dim ShareInbox As Outlook.MAPIFolder     Dim olNs As Outlook.NameSpace     Dim olRecip As Outlook.Recipient     Dim SubFolder As Object      Set olNs = Application.GetNamespace("MAPI")     Set olRecip = olNs.CreateRecipient("0m3r@Email.com") '// Owner's Name or email address     Set ShareInbox = olNs.GetSharedDefaultFolder(olRecip, olFolderInbox)     Set SubFolder = ShareInbox.Folders("Temp") 'Change this line to specify folder      ReDim varOutput(1 To SubFolder.Items.Count, 1 To 10)      For Each Item In SubFolder.Items         If TypeName(Item) = "MailItem" Then             lngcount = lngcount + 1             varOutput(lngcount, 1) = Item.SenderEmailAddress 'Sender or SenderName             varOutput(lngcount, 2) = Item.ReceivedTime 'stats on when received             varOutput(lngcount, 3) = Item.ConversationTopic 'Conversation subject             varOutput(lngcount, 4) = Item.Subject 'to split out prefix             varOutput(lngcount, 5) = Item.Categories 'to split out category             varOutput(lngcount, 6) = Item.Sender             varOutput(lngcount, 7) = Item.SenderName             varOutput(lngcount, 8) = Item.To             varOutput(lngcount, 9) = Item.CC             varOutput(lngcount, 10) = SubFolder.Name         End If     Next      'Creates a blank workbook in excel     Set xlApp = New Excel.Application     Set xlSht = xlApp.Workbooks.Add.Sheets(1)      xlSht.Range("A1").Resize(UBound(varOutput, 1), _                              UBound(varOutput, 2)).Value = varOutput     xlApp.Visible = True  End Sub 

文章来源: Outlook access shared inbox sub-folder