How do I copy an email to the clipboard and then paste it into excel with the tables intact?
I am using Outlook 2007 and I want to do the equivalent of
"Click on email > Select All > Copy > Switch to Excel > Select Cell > Paste".
I have the Excel Object Model pretty well figured out, but have no experience in Outlook other 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)
I must admit I use this in Outlook 2003, but please see if it works in 2007 as well:
you can use the MSForms.DataObject to 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.):
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.
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.
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.
It's enough if you have selected the mail in the list view, you don't even need to open it.
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.
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.
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.
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?
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.
Anyway code sample:
Outlook code to access the 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.
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:
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 processed per second. I do some minor processing and extracting.
Related
I've done a fair bit of searching but everything I've come up with is doing the opposite of what I'm trying to do.
I have a whole bunch of automatically generated emails that I get, and I want to translate them down into excel. Everything works, except that it dumps it exclusively into one cell. I would like this to have multiple rows of the email come through as multiple lines in excel.
For example, email body is this. This will have a variable number of rows, so I can't really just use Mid functions.
Hello,
Job AAA completed successfully.
ThingA1 = good
ThingA2 = error code 5
This entire string shows up under cell A2 (which, is kinda what I told it to do...but I have no idea how to tell it to put it as multiple IDs). I want it to show up as different cells (covering cells A2:A6 in this instance).
Sub ParseAllEmails()
'loop through the outlook inbox, find stuff with errors, parse/paste it in
Dim OutApp As Outlook.Application, OLF As Outlook.MAPIFolder, OutMail As Outlook.MailItem
Dim myReport As Boolean, zeroErrors As Boolean
Dim parseSht As Worksheet
Dim i As Long
'establish connection
Set OutApp = CreateObject("Outlook.Application")
Set OLF = OutApp.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
Set parseSht = ThisWorkbook.Sheets("parse")
'go through inbox looking for scheduler emails
For i = OLF.Items.Count To 1 Step -1
If TypeOf OLF.Items(i) Is MailItem Then
Set OutMail = OLF.Items(i)
myReport = (LCase(Left(OutMail.Subject, 3)) = "job")
zeroErrors = (InStr(1, LCase(OutMail.Subject), "errors=0") > 0)
If myReport And Not zeroErrors Then
parseSht.Range("A2:A500").Value = Trim(OutMail.Body)
Exit Sub
End If
End If
Next
End Sub
First of all, I'd suggest replacing the following part where the code iterates over all items in the Inbox folder:
'go through inbox looking for scheduler emails
For i = OLF.Items.Count To 1 Step -1
If TypeOf OLF.Items(i) Is MailItem Then
Set OutMail = OLF.Items(i)
myReport = (LCase(Left(OutMail.Subject, 3)) = "job")
zeroErrors = (InStr(1, LCase(OutMail.Subject), "errors=0") > 0)
If myReport And Not zeroErrors Then
Use the Find/FindNext or Restrict methods of the Items class which allow getting items that correspond to your conditions only. All you need is to iterate over the result collection and process such items after. Read more about these methods in the following articles:
How To: Use Find and FindNext methods to retrieve Outlook mail items from a folder (C#, VB.NET)
How To: Use Restrict method to retrieve Outlook mail items from a folder
To break the single message body string into separate lines you could use the Slit function available in VBA:
Dim strings() As String
strings = Split(mailItem.Body, vbNewLine)
So, you can detect the data which is required to be pasted and process these lines in the loop by adding each entry into a separate cell (if required).
Using MS Word (in my case 2010 version), I have constructed a form with Content Control elements to be filled out by the user. Now I want certain entries (that I already gave titles to) be shown in a chart inside the same Word document (not in a separate Excel document).
This should be an automated process, so that if the user changes one of the Content Control entries, the chart updates itself automatically; I would also be OK if the user had to press a button in order to update the chart (but the user shouldn't have to click around a lot, since I must assume the user to have little skills.)
So I inserted an Excel chart object in my Word form document. I also wrote some VBA code inside this Excel object to read the Content Control values from the Word document as source for the chart. But I think what I really need is the VBA code to be in my Word document itself (for example to be executed upon click on a button by the user), yet I don't know how to address the Excel chart object and the cells within.
My VBA code inside the Excel object is:
Sub ChartDataAcquirer()
Dim wdApp As Object
Dim wdDoc As Object
Dim DocName As String
Dim ccX As String
Dim ccY As String
Dim datapairs As Integer
'''''''''' Variables '''''''''
DocName = "wordform.docm"
ccX = "titleX"
ccY = "titleY"
datapairs = 5
''''''''''''''''''''''''''''''
Set wdApp = GetObject(, "Word.Application")
Set wdDoc = wdApp.Documents(DocName)
Dim i As Integer
For i = 1 To datapairs
With ActiveSheet.Cells(i + 1, 1) ' The first row contains headline, therefore i+1
.Value = wdDoc.SelectContentControlsByTitle(ccX & i).Item(1).Range.Text ' The CC objects containing the x values have titles "titleX1", "titleX2" ..., therefore "ccX & i"
On Error Resume Next
.Value = CSng(wdDoc.SelectContentControlsByTitle(ccX & i).Item(1).Range.Text) ' To transform text into numbers, if user filled the CC object with numbers (which he should do)
End With
With ActiveSheet.Cells(i + 1, 2)
.Value = wdDoc.SelectContentControlsByTitle(ccY & i).Item(1).Range.Text
On Error Resume Next
.Value = CSng(wdDoc.SelectContentControlsByTitle(ccY & i).Item(1).Range.Text)
End With
Next
End Sub
I guess I need a similar code that is placed in and operates from the Word form document itself, but that is where I am stuck...
The following is demo code that shows how to access an embedded Excel chart.
Note that the Name (Shapes([indexValue])) of your chart Shape is probably different than in this code. You'll need to check and change that assignment. Also, your chart may be an InlineShape rather than a Shape, so you may need to adjust that bit, as well.
This code checks whether the Shape is actually a chart. If it is, the Chart object is accessed as well as its data sheet. Via that, it's possible to get the actual workbook, the worksheets, even the Excel application if you should need it.
Sub EditChartData()
Dim doc As Word.Document
Dim shp As Word.Shape
Dim cht As Word.Chart
Dim wb As Excel.Workbook, ws As Excel.Worksheet, xlApp As Excel.Application
Set doc = ActiveDocument
Set shp = doc.Shapes("MyChart")
If shp.HasChart Then
Set cht = shp.Chart
cht.ChartData.Activate
Set wb = cht.ChartData.Workbook
Set xlApp = wb.Application
Set ws = wb.ActiveSheet
Debug.Print ws.Cells(1, 2).Value2
End If
Set ws = Nothing
Set wb = Nothing
Set cht = Nothing
Set xlApp = Nothing
End Sub
I'm trying to search an MS Word doc for embedded Excel files and save them to a different location.
1) I want to record the page number and or section name (based on header style) the embedded file was located in the Word Doc. How can I extract this info?
2) Is there anyway to get the original filename of the embedded Excel file?
Here is the code I'm using to search for embedded files. Originally
Working off the code first presented here: Extract Embeded Excel Workseet Data
Sub TestMacro2()
Application.ScreenUpdating = False
Application.DisplayAlerts = wdAlertsNone
Dim lNumShapes As Long
Dim lShapeCnt As Long
Dim xlApp As Object
Dim wrdActDoc As Document
Dim iRow As Integer
Dim iCol As Integer
Set wrdActDoc = ActiveDocument
For lShapeCnt = 1 To wrdActDoc.InlineShapes.Count
If wrdActDoc.InlineShapes(lShapeCnt).Type = wdInlineShapeEmbeddedOLEObject Then
If wrdActDoc.InlineShapes(lShapeCnt).OLEFormat.ProgID = "Excel.Sheet.8" Then
wrdActDoc.InlineShapes(lShapeCnt).OLEFormat.Edit
Set xlApp = GetObject(, "Excel.Application")
cpath = "location of interest"
xlApp.Workbooks(1).SaveAs cpath & " " & lShapeCnt
xlApp.Workbooks(1).Close
xlApp.Quit
Set xlApp = Nothing
End If
End If
Next lShapeCnt
End Sub
Note: Your code would be more efficient (and easier to read) if you assign an object that's re-used to a variable:
Dim ils as Word.InlineShape
Set ils = wrdActDoc.InlineShapes(lShapeCnt)
(1) The Range.Information method can return the page number. Something like:
Dim pageNumber as Long
pageNumber = ils.Range.Information(wdwdActiveEndPageNumber)
The other option is not as straight forward... I expect you really mean Heading style, not Header style. There is a built-in bookmark that will get the Heading preceding the current selection. That would be something like:
Dim secName as String
ils.Range.Select
secName = ActiveDocument.Bookmarks("\HeadingLevel").Range.Text
(2) If the file is not linked then your chances are slim. There's nothing VBA can get at directly, that's certain. Possibly, something might be stored in the WordOpenXML. You can check that by downloading the Open XML SDK Productivity Tool, opening such a document in it and inspecting that part of the Open XML. If it's in there then you can get at it in VBA using ils.Range.WordOpenXML to get the Open XML for the InlineShape, then parse that.
I have an Excel file which will be used as a tool collate tables from mails. One mail will have only one table and one record in it. I need to collate the records in all such tables (from different mails) into One Excel table. I have the following code to do it. This code when run, copies the entire text in body of mail to Excel (So the code works only if the mail has Table with no other text in the body of mail). But I need to copy only the Table present in the mail to Excel. Please help me modify the code to do this. Please note that I do not want to write any code in outlook. Also the copied table is pasted as text. I want them to get pasted in table format. The part of the code which will need modification is shown below.
Public Sub ExportToExcel1()
Application.ScreenUpdating = False
'Variable declaration
Dim i As Integer
Dim ns As Namespace
Dim Inbox As Outlook.MAPIFolder
Dim item As Object
Dim doClip As MSForms.DataObject
Dim d As String
'Set values for variables
i = 2
d = ActiveSheet.Range("subject").Value
Set ns = GetNamespace("MAPI")
Set Inbox = ns.GetDefaultFolder(olFolderInbox)
Set doClip = New MSForms.DataObject
'Loop to check mails and pull data
For Each item In Inbox.Items
If TypeName(item) = "MailItem" And item.Subject = d Then
doClip.SetText item.Body
doClip.PutInClipboard
ActiveSheet.Cells(1, 1).PasteSpecial "Text"
EndSub
There are two mistakes in your code:
You access item.Body which is the text body when you need the Html body.
You paste the entire body into the worksheet when you only want the table.
You need some extra variables:
Dim Html As String
Dim LcHtml As String
Dim PosEnd As Long
Dim PosStart As Long
Replace the If statement with:
If TypeName(item) = "MailItem" And item.Subject = d Then
Html = item.HTMLBody
LcHtml = LCase(Html)
PosStart = InStr(1, LcHtml, "<table")
If PosStart > 0 Then
PosEnd = InStr(PosStart, LcHtml, "</table>")
If PosEnd > 0 Then
Debug.Print "[" & Mid(Html, PosStart, PosEnd + 8 - PosStart) & "]"
doClip.SetText Mid(Html, PosStart, PosEnd + 8 - PosStart)
doClip.PutInClipboard
ActiveSheet.Cells(1, 1).PasteSpecial "Text"
End If
End If
End If
How do I track e-mails in and out of a shared in-box in Outlook using excel? We have a large number of e-mails coming in and we need to track responses to make sure that e-mails don't get lost.
Is there as way to get the results from advanced find to an excel sheet?
What view are you setting up in advanced find ? As you can write a VBA macros to pull items from your inbox and put them into you speadsheet. Alot of the advance find option are not in the outlook object model so it depends on the view you are trying to set up.
So can you tell me what you are doing in advanced find ..?
76mel
Ok using outlook tables you can put this in your Excel as a macro
Use "sfilter" to define your advance search criteria.
You will have to pump the data into Excel at the bottom.
Sub GetMail()
Dim oApp As Outlook.Application
Dim oFolder As Outlook.Folder
Dim oNameSpace As Outlook.Namespace
Dim emailCount As Integer
Dim counter As Integer
Dim sfilter As String
Dim oRow As Outlook.Row
Dim oTable As Outlook.Table
Dim i As Outlook.MailItem
Set oApp = CreateObject("Outlook.Application")
Set oNameSpace = oApp.Session
Set oFolder = oNameSpace.GetDefaultFolder(olFolderInbox)
'Add what ever filter you want here using DASL
sfilter = "[LastModificationTime] > '5/1/2005'"
'Restrict with Filter
Set oTable = oFolder.GetTable(sfilter)
'Remove all columns in the default column set
oTable.Columns.RemoveAll
'Specify desired properties
With oTable.Columns
.Add ("EntryID")
.Add ("Subject")
.Add ("ReceivedTime")
End With
'Enumerate the table using test for EndOfTable
'Pump it into your worksheet
Do Until (oTable.EndOfTable)
Set oRow = oTable.GetNextRow()
Debug.Print (oRow("EntryID"))
Debug.Print (oRow("Subject"))
Debug.Print (oRow("ReceivedTime"))
Loop
'Clean up
Set oTable = Nothing
Set oFolder = Nothing
Set oNameSpace = Nothing
Set oApp = Nothing
End Sub
Maybe you should invest in a tool like FogBugz that can handle incoming email, filters spam and tracks responses.
I've found a stop gap measure; just highlight all results you get from advanced find, then ctrl + A, then ctrl + C, you can then paste the results into excel (ctrl + V).
Still I'd like to hear of any other solutions.
Excel doesn't do this well. At my company we simply use flags for anything urgent. When someone responds to a customer, they drag the original message to their folder within the shared mailbox.