none
Copy a table from body of an email to Excel spreadsheet RRS feed

  • Question

  • I wish to extract one row from each of 5 tables in an email body (not an attachment) and export it to an excel worksheet.  It sounds simple, but everything I try generates an error message.

    In more detail, I send out each month to various recipients an email that contains 6 three row tables asking for their availability for three shifts each day for a rota.  The first table contains their names, emails, qualifications etc, and in the remaining tables (one for each week) the top two lines contain the day and date (row 1), and the shift number (row 2).  They reply to me, simply filling in their availability for a particular day and shift with a “Y” in the appropriate column in row 3 if they are available for that shift.  The email and the reply are always in the same format.

    I can copy the relevant row manually by copying (Ctrl + C) in the email, opening the spreadsheet and then pasting (Ctrl + V) into the relevant row of the spreadsheet, but it would ease my task considerably to run a procedure to do that for me.  Once I know how to copy and paste the data I can work out how to do it for each table and how to associate the availability with the appropriate name;  it is the code to set up and execute the copying procedure, open the spreadsheet and then paste the data that has beaten me.

    Any help gratefully received.
    Friday, September 6, 2013 4:45 PM

Answers

  • Take look on this:

    Sub dd()
    Dim item As MailItem, x%
    Dim r As Object  'As Word.Range
    Dim doc As Object 'As Word.Document
    Dim xlApp As Object, wkb As Object
    Set xlApp = CreateObject("Excel.Application")
    Set wkb = xlApp.Workbooks.Add
    xlApp.Visible = True
    
    Dim wks As Object
    Set wks = wkb.Sheets(1)
    
    For Each item In Application.ActiveExplorer.Selection
    Set doc = item.GetInspector.WordEditor
        For x = 1 To doc.tables.Count
         Set r = doc.tables(x)
            r.Range.Copy
           wks.Paste
           wks.Cells(wks.Rows.Count, 1).End(3).Offset(1).Select
        Next
    Next
    End Sub


    Oskar Shon, Office System MVP - www.VBATools.pl
    if Helpful; Answer when a problem solved

    • Marked as answer by AndyColRomsey Tuesday, September 10, 2013 7:44 AM
    Monday, September 9, 2013 9:17 PM

All replies

  • assuming you're having problems with the excel part, here's what works for me:

    Microsoft.Office.Interop.Excel.Application xlApp = new Microsoft.Office.Interop.Excel.Application(); Microsoft.Office.Interop.Excel.Workbook xlWorkBook = xlApp.Workbooks.Open(file, Type.Missing, Type.Missing, Type.Missing, Type.Missing, Type.Missing, Type.Missing, Type.Missing, Type.Missing, Type.Missing, Type.Missing, Type.Missing, Type.Missing, Type.Missing, Type.Missing); Microsoft.Office.Interop.Excel.Worksheet sheet = (Microsoft.Office.Interop.Excel.Worksheet)xlWorkBook.Worksheets.get_Item(1); Microsoft.Office.Interop.Excel.Range range = sheet.get_Range("A1", "D" + (sheet.Cells.SpecialCells(Microsoft.Office.Interop.Excel.XlCellType.xlCellTypeLastCell, Type.Missing).Row + 1)); object[,] values = (object[,])range.Value2;

    Then do whatever you have to with the values array and write back:

                range.Value2 = values;
    
                xlWorkBook.SaveAs(file);

    Friday, September 6, 2013 5:46 PM
  • Hi exstud

    Thanks for looking at this, but it's not the Excel bit that is the problem.  I need to get some VBA code in Outlook to copy the third row from each table and paste it into Excel.  Or as a (rather inefficient) alternative, copy each of the tables into Excel, where I can work on them in Excel to extract the bits I want and delete the rest.

    Andy C

    Friday, September 6, 2013 8:31 PM
  • Some further information on where I am having a problem.

    With an email open that has a table with 11 columns and 3 rows I run the following code:

    Sub TableDataCopy()

        Dim doc As Object
        Dim tbl As Object
        Dim cel As Object
        Dim tblRow As Object
        Dim objExcel As Excel.Application
        Dim objWB As Excel.Workbook
        Dim strFileName As String
        Dim varAvailability As Variant

        If TypeName(ActiveWindow) = "Explorer" Then
            MsgBox "Please open an e-mail message!", vbExclamation
            Exit Sub
        End If
        If ActiveInspector.CurrentItem.Class <> olMail Then
            MsgBox "Please open an e-mail message!", vbExclamation
            Exit Sub
        End If
        Set doc = ActiveInspector.WordEditor
        If doc.Tables.Count = 0 Then
            MsgBox "This message doesn't contain a table!", vbExclamation
            Exit Sub
        End If
        
        'strFileName = "C:\Users\'username\Documents\AvailabilityTemplate.xlsx"
        'Set objExcel = CreateObject("Excel.Application")
        'Set objWB = objExcel.Workbooks.Open(strFileName)
        'objExcel.Visible = True
        'objWB.Activate

        Set tbl = doc.Tables(1)
        Set tblRow = tbl.Rows(3)  'NB This does not work if there are vertically merged cells

         **** THE PROBLEMS ARE HERE ****

        'tblRow.Copy                                      'Object doesn't support this property or method
        varAvailability = tblRow.GetValues     'Object doesn't support this property or method
        
        ........

    Set doc = Nothing
    Set objExcel = Nothing
    Set objWB = Nothing
    Set tbl = Nothing
    Set tblRow = Nothing

    End Sub

            The line  "tblRow.Copy" does not work (though I don't see why) so I commented it out, but from eveythig that I have read the line "varAvailability = tblRow.GetValues" should do what I want!

    In the Locals window I can see that tbl has correctly identified the table as having 11 columns

    I have tried setting "Dim tbl As Outlook.Table"  and "Dim tblRow As Oultook.Row"  That just moved the error message further up the code!  Clearly I have got the syntax wrong somewhere in here.  Can any knowledgable person please tell me where the error is?

    Thanks

    Saturday, September 7, 2013 5:19 PM
  • Take look on this: Kopiowanie tabeli z Worda do Excela

    This is a code coping WD Table to XL, but you can look around this solution.


    &lt;b&gt;Oskar Shon&lt;/b&gt;, Office System &lt;a href=&quot;https://mvp.support.microsoft.com/profile/Oskar.Shon&quot;&gt; MVP&lt;/a&gt; &lt;p&gt;Press &lt;span lang=&quot;en&quot;&gt;&lt;span&gt;&lt;img src=&quot;http://vbatools.pl/wp-content/uploads/2011/12/triangle.png&quot; alt=&quot;&quot;&gt;&lt;/span&gt;&lt;/span&gt; if Helpful; Answer when a problem solved&lt;/p&gt;

    Sunday, September 8, 2013 6:14 PM
  • Thanks to "VBA Tools" for looking at this.  That is a neat procedure for getting the tables from Word to Excel, but the problem that I have first is extracting the tables, or parts of the tables, from an Outlook email body.

    z podziękowaniami

    Andy C

    Monday, September 9, 2013 7:16 AM
  • Take look on this:

    Sub dd()
    Dim item As MailItem, x%
    Dim r As Object  'As Word.Range
    Dim doc As Object 'As Word.Document
    Dim xlApp As Object, wkb As Object
    Set xlApp = CreateObject("Excel.Application")
    Set wkb = xlApp.Workbooks.Add
    xlApp.Visible = True
    
    Dim wks As Object
    Set wks = wkb.Sheets(1)
    
    For Each item In Application.ActiveExplorer.Selection
    Set doc = item.GetInspector.WordEditor
        For x = 1 To doc.tables.Count
         Set r = doc.tables(x)
            r.Range.Copy
           wks.Paste
           wks.Cells(wks.Rows.Count, 1).End(3).Offset(1).Select
        Next
    Next
    End Sub


    Oskar Shon, Office System MVP - www.VBATools.pl
    if Helpful; Answer when a problem solved

    • Marked as answer by AndyColRomsey Tuesday, September 10, 2013 7:44 AM
    Monday, September 9, 2013 9:17 PM
  • Hi Oskar

    Many thanks.  That does exactly what I wanted and is commendably short!

    Andy C

    Tuesday, September 10, 2013 7:45 AM
  • Hi,

    Firstly Thank you very much for this code, it is extremely helpful.

    The data i am copying contains mobile phone numbers that start with 0 and when they are pasted in excel the 0's are dropped off the front of the phone number. could you please tell me what syntax i can use to paste values so it does not drop the 0's?

    Thanks in advance

    Regards

    Andy



    • Edited by ARod_87 Thursday, October 3, 2013 1:41 AM
    Thursday, October 3, 2013 1:41 AM
  • Hi Oscar,

    I have used the above code to copy the tables from mail to the excel worksheet,

    I am facing the problem while executing the code for multiple mails. 

    Eg: The code is working perfectly fine. But when i select the multiple mails and run the code, the data in excel is getting copied from the mail and appended one below another but till the 1943 rows the data is copied after that its not, can you please help me figuring this out.

    Regards,

    Sandeep

    Wednesday, December 2, 2015 9:28 AM
  • where do I paste the above code, in outlook or Excel?

    Im getting error on 

    For Each item In Application.ActiveExplorer.Selection

    Wednesday, December 30, 2015 4:27 PM
  • Well, if you don't feel like coding, you can try parseur.com

    It's a software as a service that can extract table from your email and put it into an Excel spreadsheet.

    More info here: https://parseur.com/how-to/parse-repetitive-blocks-of-text-in-emails/

    • Proposed as answer by Intuitivo Wednesday, November 22, 2017 12:53 PM
    Wednesday, November 22, 2017 12:53 PM