Outlook Access共享收件箱子文件夹 [英] Outlook access shared inbox sub-folder
问题描述
以下代码中存在一个奇怪的问题,我用于将Outlook电子邮件信息提取到Excel中.有时代码可以正常运行,但有时我会收到运行时错误 '-2147221233 (8004010f)'
.当我确实收到此错误时,出现问题的是 Set objFolder = objMailbox.Folders("Inbox").Folders("ARCHIVE")
行.
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.
我正在共享收件箱上运行代码,并且将"ARCHIVE"文件夹作为收件箱的子文件夹.好像代码即使在该文件夹中也找不到该文件夹,并且有时可以找到它.
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
推荐答案
我假设您正在从Outlook运行代码,请参阅我所做的清理工作.
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共享收件箱子文件夹的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!