Copy email to clipboard with Outlook VBA

Question

How to copy a letter to the clipboard and then paste it into excel with intact tables?

I am using Outlook 2007 and I want to make an equivalent

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

I have an Excel object model, pretty well calculated, but in Outlook there is no more than the following code.

 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

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

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

 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, go to Excel and press Ctrl-V - there we go! If you also want to find the current Excel application and automate it, let me know.

Valid HTMLBody always exists, even when mail has been sent to Plain Text or RTF, and Excel will display all text attributes passed to HTMLBody, incl. columns, colors, fonts, hyperlinks, indents, etc. However, embedded images are not copied.

This code demonstrates the essence, but does not check if MailItem is actually selected. This will require more coding if you want it to work for calendar entries, contacts, etc. Also.

It’s enough if you selected mail as a list, you don’t even need to open it.

Answer 2

I finally lifted it again and completely automated. Here is the basic information about 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 deal with 300 emails, this translates to at least ten minutes.

I got the code that I need a TechRepublic article , and then changed it to fit my needs. Many thanks to the accepted author of this question for the clipboard code.

Answer 3

Okay, so I have to make certain assumptions because there is no information in your question. Firstly, you didn’t say in which mail format this message is ... HTML would be the simplest, the process would be different for RTF and not possible in plain text Since you are referencing tables, I assume that they are HTML tables, and the mail format is HTML.

It is also unclear from your question whether you want the contents of the table to be inserted separately (1 excel cell per table cell), and the rest of the text text of the email to be inserted into 1 cell or several?

Finally, you really didn’t say whether you want VBA to work from Outlook or Excel (not so important, but it affects what internal objects are available.

Anyway, the sample code: Outlook code to access htmlbody prop

 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

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

 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 

Medium: 77 letters are processed per second. I do a little processing and extraction.