Question

我正在尝试将Outlook中共享收件箱的子文件夹中的电子邮件信息导入Excel电子表格。到目前为止我遇到了很多问题，即访问收件箱的子文件夹，但找到了解决方案。我现在遇到的问题是在收件箱中存在相同数量的电子邮件后代码停止。例如，我正试图从＆＃34;存档＆＃34;文件夹（收件箱的子文件夹）但如果我的收件箱中有20封电子邮件，则当计数达到20时代码会停止，并且只会在＆＃34;存档＆＃34;中提供20个项目的信息。夹

请参阅下面从Outlook执行的代码。我已经标记了代码停止的位置。它给了我错误＆＃34; aOutput（lCnt，1）=下标超出范围＆＃34;当我把光标移到＆＃34; aOutput＆＃34;。如果我将代码跳到＆＃34; SetxlApp ...＆＃34;它会给我一个excel表填充所有电子邮件的数据到那一点（20封电子邮件，即我的收件箱中的相同数量的项目）但我需要它继续循环通过文件夹的其余部分（可能是成千上万的项目）。有人可以对此有所了解吗？还有其他建议吗？谢谢你的帮助。

Sub EmailStats()

Dim olMail As Outlook.MailItem
Dim aOutput() As Variant
Dim lCnt As Long
Dim xlApp As Excel.Application
Dim xlSh As Excel.Worksheet
Dim flInbox As Folder
Dim olFolder As Outlook.MAPIFolder

Dim myNamespace As Outlook.NameSpace
Dim myRecipient As Outlook.Recipient
Set myNamespace = Application.GetNamespace("MAPI")
Set myRecipient = myNamespace.CreateRecipient("Team Inbox")

Set flInbox = Application.GetNamespace("MAPI").GetSharedDefaultFolder(myRecipient, olFolderInbox)

Set olFolder = flInbox.Folders("ARCHIVE")
ReDim aOutput(1 To flInbox.Items.Count, 1 To 4)

For Each olMail In olFolder.Items
    If TypeName(olMail) = "MailItem" Then
    On Error GoTo ErrorSkip
        lCnt = lCnt + 1
        aOutput(lCnt, 1) = olMail.SenderEmailAddress '**Code stops here**
        aOutput(lCnt, 2) = olMail.ReceivedTime
        aOutput(lCnt, 3) = olMail.ConversationTopic
        aOutput(lCnt, 4) = olMail.Subject
    End If
ErrorSkip:
Next olMail

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

Answer 1

删除ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[8],Sheet2!C[-15]:C[-14],2,FALSE)"行并查看返回的错误（如果有）。

Answer 2

经过多次试验和错误，我找到了答案。对于任何有兴趣的人，请参阅以下代码，将共享收件箱中的电子邮件详细信息导入Excel工作表。只需将“共享收件箱”文本更改为您自己的共享收件箱的名称即可。我的收件箱的结构为“共享收件箱”＆gt; “收件箱”＆gt; “存档”。您还需要在Set objFolder行上更改这些以指定所需的文件夹。

我仍有一个问题，即当代码遇到非邮件项目（未送达通知或会议邀请）时，代码会停止，但我正在处理解决方案。

Sub EmailStatsV3()

Dim olMail As Outlook.MailItem
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("Shared Inbox")

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")
Set colItems = objFolder.Items

'Specify which email items to extract
ReDim aOutput(1 To objFolder.Items.Count, 1 To 5)
For Each olMail In objFolder.Items
If TypeName(olMail) = "MailItem" Then

        lCnt = lCnt + 1
        aOutput(lCnt, 1) = olMail.SenderEmailAddress 'maybe stats on domain
        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
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

将电子邮件信息导入excel

2 个答案: