问将电子邮件信息导入到excel
EN

Stack Overflow用户

提问于 2015-08-14 15:23:27

回答 2查看 80关注 0票数 0

我正在尝试将电子邮件信息从Outlook中共享收件箱的子文件夹导入到excel电子表格中。到目前为止，我遇到了很多问题，比如访问收件箱的子文件夹，但我找到了解决方案。我现在遇到的问题是代码在收件箱中存在相同数量的电子邮件后停止。例如，我试图从"Archive“文件夹(收件箱的子文件夹)中获取信息，但如果我的收件箱中有20封电子邮件，那么当计数达到20时，代码就会停止，只给我"Archive”文件夹中20个项目的信息

请看下面从Outlook执行的代码。我已经标记了代码停止的地方。当我将光标悬停在"aOutput“上时，它显示错误"aOutput(lCnt，1) = Subscript out out range”。如果我将代码跳到"SetxlApp...“行它将给我的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

outlook

有奖征集｜云上CPU玩转AIGC挑战赛

参加活动赢取洛斐键盘、小米电纸书、智能音响等鹅厂周边！

回答 2

Stack Overflow用户

发布于 2015-08-14 16:35:12

去掉On Error GoTo ErrorSkip行，看看返回了什么错误(如果有)。

票数 0

Stack Overflow用户

发布于 2015-09-21 15:06:27

经过反复试验，我找到了答案。对于感兴趣的人，请参阅下面的代码，将电子邮件详细信息从共享收件箱导入到excel工作表中。只需将“共享收件箱”文本更改为您自己的共享收件箱的名称即可。我的收件箱结构为“共享收件箱”>“收件箱”>“存档”。您还需要在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