我在使用以下代码将 Outlook 电子邮件信息提取到 Excel 中时遇到了一个奇怪的问题。有时代码运行得很好,但有时我会收到 运行时错误
'-2147221233 (8004010f)'
。当我确实收到此错误时,问题出在 Set objFolder = objMailbox.Folders("Inbox").Folders("ARCHIVE")
行上。
我正在共享收件箱上运行代码,并且我将“ARCHIVE”文件夹作为收件箱的子文件夹。就好像代码无法找到该文件夹,即使它在那里,但有时可以找到它。
我的未经教育的猜测是,由于共享收件箱可以在所有用户之间进行延迟更新,因此如果文件夹中有任何操作,代码将无法识别该文件夹,直到它在服务器上刷新或更新为止。
任何人都可以建议稍微不同的代码,以便它每次都能运行吗?或者有人能解释为什么它只是偶尔按原样工作吗?
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 运行代码,请参阅我所做的清理。
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("[email protected]") '// 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
我也得到了同样的错误代码。我终于让它访问带有子文件夹的共享邮箱,并在新电子邮件进入时显示一条弹出消息。来自另一篇文章的代码。
Private WithEvents sharedInboxItems As Outlook.Items
Private Sub Application_Startup()
Dim sharedInbox As Outlook.Folder
Dim sharedMailboxName As String
'****************************************************
'Name of the shared mailbox
sharedMailboxName = "Shared Mailbox Name"
'****************************************************
'Get shared inbox folder
Set sharedInbox = Application.GetNamespace("MAPI").Folders(sharedMailboxName).Folders("Inbox")
'Set sharedInboxItems variable to the items in the shared inbox
Set sharedInboxItems = sharedInbox.Items
End Sub
Private Sub sharedInboxItems_ItemAdd(ByVal Item As Object)
'****************************************************************
'Apply your logic below:
'Display a message box with the subject of the new email
MsgBox "You have a new email!! Subject: " & Item.Subject
'****************************************************************
End Sub