如何将 Outlook 2010 电子邮件中的表格传输到 Excel 2010

Question

我有大约 2000 封电子邮件以 zip 文件的形式发送给我。电子邮件具有以下结构：

http://social.msdn.microsoft.com/Forums/getfile/429285

所有邮件都有相同的主题。从截图可以看出，每封邮件都有多个表。这些表在每封邮件中都有不同的行数。我的任务是将 2000 封邮件中包含的所有这些多个表格放入 excel 中以形成图形和图表。你能帮我解决如何通过自动化来解决这个问题吗？我尝试了一些可用的解决方案，但没有发现可以将 Outlook 电子邮件中的表格传输到 Excel。我有这个任务的最后期限，任何及时的帮助将不胜感激。提前致谢！

Answer 1

这对我有用。

在您的 VBA 项目中添加对 Microsoft HTML Object Library 的引用（在 VB 编辑器中的 Tools >> References 下）

假设 Outlook 已经打开，并且您的邮件存储在路径 MSG_PATH。

Sub Tester()

Const MSG_PATH As String = "C:\_Stuff\test\mails\"

Dim ol, m, t, r, c
Dim doc As New MSHTML.HTMLDocument
Dim rng As Range, rw As Object
Dim f

    Set ol = GetObject(, "outlook.application")

    Set rng = ActiveSheet.Range("B2")

    f = Dir(MSG_PATH & "*.msg")

    Do While Len(f) > 0

        Set m = ol.CreateItemFromTemplate(MSG_PATH & f)
        doc.body.innerHTML = m.htmlbody
        m.Close False

        For Each t In doc.getElementsByTagName("table")
            rng.Offset(0, -1).Value = f
            For r = 0 To t.Rows.Length - 1
                Set rw = t.Rows(r)
                For c = 0 To rw.Cells.Length - 1
                    'ignore any problems with merged cells etc
                    On Error Resume Next
                    rng.Offset(r, c).Value = rw.Cells(c).innerText
                    On Error GoTo 0
                Next c
            Next r
            Set rng = rng.Offset(t.Rows.Length + 5)
        Next t

        f = Dir()
    Loop

End Sub