使用 Outlook VBA 将电子邮件复制到剪贴板答案

【问题标题】：Copy email to the clipboard with Outlook VBA使用 Outlook VBA 将电子邮件复制到剪贴板
【发布时间】：2020-06-23 16:09:53
【问题描述】：

如何将电子邮件复制到剪贴板，然后将其粘贴到 Excel 中，并且表格完好无损？

我正在使用 Outlook 2007，我想做与

等效的操作

"Click on email > Select All > Copy > Switch to Excel > Select Cell > Paste".

我已经很好地了解了 Excel 对象模型，但除了以下代码之外，我在 Outlook 中没有经验。

Dim mapi As NameSpace
Dim msg As Outlook.MailItem
Set mapi = Outlook.Application.GetNamespace("MAPI")
Set msg = mapi.Folders.Item(1).Folders.Item("Posteingang").Folders.Item(1).Folders.Item(7).Items.Item(526)

【问题讨论】：

标签： excel vba outlook clipboard outlook-2007

【解决方案1】：

我必须承认我在 Outlook 2003 中使用了它，但请看看它是否也适用于 2007 年：

您可以使用 MSForms.DataObject 与剪贴板交换数据。在 Outlook VBA 中，创建对“Microsoft Forms 2.0 Object Library”的引用，然后尝试这段代码（您当然可以将 Sub() 附加到按钮等）：

Sub Test()
Dim M As MailItem, Buf As MSForms.DataObject

    Set M = ActiveExplorer().Selection.Item(1)
    Set Buf = New MSForms.DataObject
    Buf.SetText M.HTMLBody
    Buf.PutInClipboard

End Sub

之后，切换到 Excel 并按 Ctrl-V - 开始！如果您还想查找当前正在运行的 Excel 应用程序并自动执行此操作，请告诉我。

总是有一个有效的 HTMLBody，即使邮件是以纯文本或 RTF 格式发送的，Excel 将显示 HTMLBody 中包含的所有文本属性。列、颜色、字体、超链接、缩进等。但是，不会复制嵌入的图像。

此代码演示了基本要素，但不检查是否真的选择了 MailItem。如果您想让它也适用于日历条目、联系人等，这将需要更多的编码。

如果你在列表视图中选择了邮件就足够了，你甚至不需要打开它。

【讨论】：

找不到参考所以我把它放在一个表单中。
如果您“浏览”以获取参考，请在 ...\system32 目录中查找“fm20.dll”
我在 Windows 8.1 上使用 Outlook 2013。它只在剪贴板上复制两个垃圾字符。知道如何解决这个问题吗？我在 windows 文件夹下找不到 fm20.dll，所以按照@ArlenBeiler 的建议。
由于我没有Win8，我只能给出一般性的提示：1）在Win8/64位上尝试在...\Windows\SysWOW64中搜索； 2) 全面搜索FM20.DLL； 3) 尝试下载/注册FM20.DLL； 4) 延伸阅读stackoverflow.com/questions/18668928/…

【解决方案2】：

我终于再次拿起它并完全自动化了它。以下是我为实现自动化所做的基本工作。

Dim appExcel As Excel.Application
Dim Buf As MSForms.DataObject
Dim Shape As Excel.Shape
Dim mitm As MailItem
Dim itm As Object
Dim rws As Excel.Worksheet
'code to open excel
Set appExcel = VBA.GetObject(, "Excel.Application") 
'...
'code to loop through emails here       
Set mitm = itm
body = Replace(mitm.HTMLBody, "http://example.com/images/logo.jpg", "")
Call Buf.SetText(body)
Call Buf.PutInClipboard
Call rws.Cells(i, 1).PasteSpecial
For Each Shape In rws.Shapes
    Shape.Delete 'this deletes the empty shapes
Next Shape
'next itm

我删除了徽标网址 to save time，当您处理 300 封电子邮件时，这意味着至少节省了十分钟。

我从a TechRepublic article 获得了我需要的代码，然后根据我的需要对其进行了更改。非常感谢这个问题的剪贴板代码被接受的回答者。

【讨论】：

【解决方案3】：

好的，所以我将不得不做出某些假设，因为您的问题中缺少信息。首先，您没有说邮件是什么邮件格式... HTML 将是最简单的，RTF 的过程会有所不同，并且不可能在纯文本中由于您指的是表格，我假设它们是 HTML 表格，邮件格式是 HTML。

您的问题也不清楚您是否希望单独粘贴表格内容（每个表格单元格 1 个 excel 单元格）并将其余电子邮件正文粘贴到 1 个或多个单元格中？

最后，您还没有真正说过是否要从 Outlook 或 Excel 运行 VBA（不是那么重要，但它会影响可用的内部对象。

无论如何代码示例：访问 htmlbody 属性的 Outlook 代码

Dim mapi As Namespace
Set mapi = Application.Session
Dim msg As MailItem
Set msg = mapi.Folders.Item(1).Folders.Item("Posteingang").Folders.Item(1).Folders.Item(7).Items.Item(526) 
Dim strHTML as String
strHTML = msg.HTMLBody
' There is no object model collection for html tables within the htmlbody (which is a string of html) you will need to parse the html and collect the tables before inserting into Excel.

【讨论】：

这并没有说明如何复制它，这是我想知道的一部分，因此投反对票。
好吧，但是将文本放入数据对象是微不足道的。我看到我错过了问题的那一部分。我的假设不好，但是有趣的代码是让文本开始。

【解决方案4】：

又过了一会儿，我找到了另一种方法。 MailItem.Body 是纯文本，在表格单元格之间有一个制表符。所以我用了那个。以下是我所做的要点：

Sub Import()
    Dim itms As Outlook.Items
    Dim itm As Object
    Dim i As Long, j As Long
    Dim body As String
    Dim mitm As Outlook.MailItem
    For Each itm In itms
        Set mitm = itm
        ParseReports (mitm.body) 'uses the global var k
    Next itm
End Sub
Sub ParseReports(text As String)
    Dim table(1 To 1000, 1 To 11) As String 'I'm not expecting to see a thousand rows!
    Dim drow(1 To 11) As String
    For Each Row In VBA.Split(text, vbCrLf)
        j = 1
        For Each Col In VBA.Split(Row, vbTab)
            table(i, j) = Col
            j = j + 1
        Next Col
        i = i + 1
    Next Row
    For i = 1 To l
        For j = 1 To 11
            drow(j) = table(i, j)
        Next j
        hws.Range(hws.Cells(k, 1), hws.Cells(k, 11)) = drow
        k = k + 1
    Next i
End Sub

平均：每秒 77 封电子邮件处理。我做了一些小的处理和提取。

【讨论】：