Question

如何将电子邮件复制到剪贴板，然后将其粘贴到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)

Answer 1

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

您可以使用 MSForms.DataObject 与剪贴板交换数据。在Outlook VBA中，创建对“ Microsoft Forms 2.0对象库”的引用，并尝试此代码（您当然可以将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。如果你想让它适用于日历条目，联系人等，这将需要更多的编码。

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

Answer 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获得了我需要的代码，然后根据我的需要进行了更改。非常感谢剪贴板代码对这个问题的接受回答。

Answer 3

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

此外，您的问题还不清楚您是否希望单独粘贴表格内容（每个表格单元格为1个excel单元格），其余的电子邮件正文文字粘贴到1个单元格中？

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

无论如何代码示例：用于访问htmlbody prop的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.

Answer 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封电子邮件已处理。我做了一些小的处理和提取。

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

4 个答案: