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

声明:本页面是StackOverFlow热门问题的中英对照翻译,遵循CC BY-SA 4.0协议,如果您需要使用它,必须同样遵循CC BY-SA许可,注明原文地址和作者信息,同时你必须将它归于原作者(不是我):StackOverFlow 原文地址: http://stackoverflow.com/questions/3949918/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me): StackOverFlow

提示:将鼠标放在中文语句上可以显示对应的英文。显示中英文
时间:2020-09-11 12:11:51  来源:igfitidea点击:

Copy email to the clipboard with Outlook VBA

excel-vbaclipboardoutlook-2007outlook-vbavba

提问by Arlen Beiler

How do I copy an email to the clipboard and then paste it into excel with the tables intact?

如何将电子邮件复制到剪贴板,然后将其粘贴到 excel 中,表格完好无损?

I am using Outlook 2007 and I want to do the equivalent of

我正在使用 Outlook 2007,我想做相当于

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

I have the Excel Object Model pretty well figured out, but have noexperience in Outlook other than the following code.

我已经很好地了解了 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)

回答by MikeD

I must admit I use this in Outlook 2003, but please see if it works in 2007 as well:

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

you can use the MSForms.DataObjectto exchange data with the clipboard. In Outlook VBA, create a reference to "Microsoft Forms 2.0 Object Library", and try this code (you can of course attach the Sub() to a button, etc.):

您可以使用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

After that, switch to Excel and press Ctrl-V - there we go! If you also want to find the currently running Excel Application and automate even this, let me know.

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

There's always a valid HTMLBody, even when the mail was sent in Plain Text or RTF, and Excel will display all text attributes conveyed within HTMLBody incl. columns, colors, fonts, hyperlinks, indents etc. However, embedded images are not copied.

始终存在有效的 HTMLBody,即使邮件以纯文本或 RTF 格式发送,Excel 也会显示 HTMLBody 中传达的所有文本属性,包括。列、颜色、字体、超链接、缩进等。但是,不会复制嵌入的图像。

This code demonstrates the essentials, but doesn't check if really a MailItem is selected. This would require more coding, if you want to make it work for calendar entries, contacts, etc. as well.

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

It's enough if you have selected the mail in the list view, you don't even need to open it.

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

回答by Arlen Beiler

I finally picked it up again and completely automated it. Here are the basics of what I did to automate it.

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

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

I removed the logo urls to save time, and when you're dealing with 300 emails, that translates into at least ten minutes saved.

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

I got the code I needed from a TechRepublic article, and then changed it to suit my needs. Many thanks to the accepted answerer of this question for the clipboard code.

我从TechRepublic 的一篇文章中获得了我需要的代码,然后对其进行了更改以满足我的需要。非常感谢剪贴板代码这个问题的公认回答者。

回答by Arlen Beiler

After a while again, I found another way. MailItem.Body is plain text, and has a tab character between table cells. So I used that. Here is the gist of what I did:

又过了一会儿,我找到了另一种方法。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

Average: 77 emails processedper second. I do some minor processing and extracting.

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

回答by Anonymous Type

Ok so I will have to make certain assumptions because there is information missing from your question. Firstly you didn't say what mailformat the message is... HTML would be the easiest, the process will be different for RTF and not possible in plaintext Since you are refering to tables I will assume they are HTML tables and the mail format is HTML.

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

Also it is not clear from your question if you want the table content pasted seperately (1 excel cell per table cell) and the rest of the emails bodytext pasted into 1 cell or several?

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

finally you haven't really said if you want the VBA running from Outlook or Excel (not that important but it affects which intrinsic objects are available.

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

Anyway code sample: Outlook code to access the htmlbody prop

无论如何代码示例:访问 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.