Tip: Other languages are Google-Translated. You can visit the English version of this link.
Log in
x
or
x
x
Register
x

or

How to export email body table to excel in Outlook?

When you receive an Email that contains some tables in the body, sometimes, you may need to export all tables from the message body to an excel worksheet. Normally, you can copy and paste the tables to worksheet, but, here, I will talk about a useful method to solve this job when there are multiple tables needed to be exported.

Export all tables from Outlook message body to Excel worksheet with VBA code


Export all tables from Outlook message body to Excel worksheet with VBA code

Please apply the following VBA code to export all tables from one message body to Excel worksheet.

1. Open the message that you want to export the tables, and then hold down the ALT + F11 keys to open the Microsoft Visual Basic for Applications window.

2. Click Insert > Module, and paste the following code in the Module window.

VBA code: Export all tables from message body to excel worksheet:

Sub ImportTableToExcel()
Dim xMailItem As MailItem
Dim xTable As Word.Table
Dim xDoc As Word.Document
Dim xExcel As Excel.Application
Dim xWb As Workbook
Dim xWs As Worksheet
Dim I As Integer
Dim xRow As Integer
On Error Resume Next
Set xExcel = New Excel.Application
Set xWb = xExcel.Workbooks.Add
xExcel.Visible = True
Set xWs = xWb.Sheets(1)
xRow = 1
For Each xMailItem In Application.ActiveExplorer.Selection
    Set xDoc = xMailItem.GetInspector.WordEditor
    For I = 1 To xDoc.Tables.Count
        Set xTable = xDoc.Tables(I)
        xTable.Range.Copy
        xWs.Paste
        xRow = xRow + xTable.Rows.Count + 1
        xWs.Range("A" & CStr(xRow)).Select
    Next
Next
End Sub

doc export tables to excel 1

3. After pasting the above code, still in the Microsoft Visual Basic for Applications window, click Tools > References to go to the References-Project1 dialog box, and check Microsoft Word Object Library and Microsoft Excel Object Library options from the Available References list box, see screenshot:

doc export tables to excel 2

4. Then click OK button to exit the dialog box, and now, please F5 key to run the code, all tables in the message body have been exported to a new workbook as following screenshot shown:

doc export tables to excel 3

 

Recommended Productivity Tools

shot kutools outlook kutools tab 1180x121
shot kutools outlook kutools plus tab 1180x121

Kutools for Outlook - More than 100 Advanced Functions for Outlook, Improve 70% Efficiency For you

  • Complicated and repeated operations can be done a one-time processing in seconds.
  • Forward multiple emails individually with one-click, and auto forward by rules.
  • Auto CC/BCC every sending email and easy for customizing rules, and auto reply without requiring exchange server.
  • Powerful junk emails filter, remove duplicate emails, reply with attachment, bunch of one-click operations, and so on...
  • 60-day unlimited free trial. 60-day money back guarantee. 2 years free upgrade and support. Buy once, use forever.
Say something here...
symbols left.
You are guest ( Sign Up? )
or post as a guest, but your post won't be published automatically.
Loading comment... The comment will be refreshed after 00:00.
  • To post as a guest, your comment is unpublished.
    arshad · 1 months ago
    Even I receive many email with specific subject which I want to extract those tables in that email... help needed
    • To post as a guest, your comment is unpublished.
      skyyang · 1 months ago
      Hello, arshad,
      Do you mean to export all tables from the messages with the same subject into a worksheet?
  • To post as a guest, your comment is unpublished.
    Arshad · 1 months ago
    This VBA code is not working for me... after run not getting exported in excel
  • To post as a guest, your comment is unpublished.
    steve · 1 months ago
    I found a bug with this that I have not been able to resolve.

    If I multi-select two emails, one with a single table and one with three tables, and run the code, Outlook crashes. But I noticed it is very specific to the order that the emails are initially selected.

    1. For example if I click on the email with the three tables first, then ctrl-click the email with one table, the code runs without error.

    2. If I do #1 first, then re-select the emails, this time click on the email with one table, then ctrl-click the email with three tables, it also run w/o error

    3. Now if I close and restart Outlook and first click on the email with one table, then ctrl-click the email with three tables, Outlook crashes.

    I also notice that when it does crash, it does it after it has copied/pasted the second table and before it does the third. In fact it doesn't even make it to the 'For I = 1 To xDoc.Tables.Count' to get the third table.

    The tables are 43 rows and 7 columns. There is not other text in the emails and I removed all data from the tables, so it is not related to the data in them. I tried removed rows and at some point it will start working, but not sure what that is telling me.

    Does anyone know why this is happening?
    • To post as a guest, your comment is unpublished.
      PatrickM · 23 days ago
      Having the same issue here. No solution yet but thought I would let you know you are not alone.
  • To post as a guest, your comment is unpublished.
    Blessy · 3 months ago
    Need help. I am a newbie and tried VBA code to copy table from outlook mail with specific subject to excel in specific location

    Daily I receive a mail with subject "Backup Status today" and looking for a code to open that mail, copy the table and paste the table in excel in a specific location.

    Issue: Code runs fine, no error. Mail gets opened and Excel gets opened but the table is not copied. Not sure where I went wrong. Please help.

    Sub Openmail()

    Dim xMailItem As Variant
    Dim olNs As Outlook.NameSpace
    Dim olFldr As Outlook.MAPIFolder
    Dim olItms As Outlook.Items
    Dim xTable As Word.Table
    Dim xDoc As Word.document
    Dim wordApp As Object
    Dim xExcel As Object
    Dim xWb As Workbook
    Dim xWs As Worksheet
    Dim I As Long
    Dim v As Integer
    Dim xRow As Integer
    Dim StrFile$
    On Error Resume Next

    Set olApp = New Outlook.Application
    Set olNs = olApp.GetNamespace("MAPI")
    Set olFldr = olNs.GetDefaultFolder(olFolderInbox)
    Set olItms = olFldr.Items
    Set wordApp = CreateObject("Word.Application")
    Set xExcel = CreateObject("Excel.Application")

    xRow = 1
    I = 1

    For Each xMailItem In olItms
    If Int(xMailItem.ReceivedTime) >= Date Then
    If InStr(xMailItem.Subject, "Backup Status today") > 0 Then
    'xMailItem.Display
    Set xDoc = xMailItem.GetInspector.WordEditor
    For v = 1 To xDoc.Tables.Count
    Set xTable = xDoc.Tables(v)
    xTable.Range.Copy
    StrFile = "C:\Users\priyanka.jeganathan\OneDrive - Accenture\Accenture\Learning\Daily DashBoard Basesheet.xlsx"
    Set xWb = xExcel.Workbooks.Open(StrFile)
    Set xWs = xWb.Worksheets("IRIS Daily")
    xWs.Activate
    xWs.Paste
    xRow = xRow + xTable.Rows.Count + 1
    xWs.Range("A" & CStr(xRow)).Select
    Next
    I = I + 1
    End If
    End If
    Next xMailItem
    xWs.Display
    xWs.Range("A1:A6").ColumnWidth = 43
    xWs.Rows("1:6").RowHeight = 16.5
    Set olFldr = Nothing
    Set olNs = Nothing
    Set olApp = Nothing
    End Sub
    • To post as a guest, your comment is unpublished.
      skyyang · 3 months ago
      Hello, Blessy,
      If you want to open the email with specific subject and export the tables from the message body to an Excel file, may be the below VBA code can do you a favor, please try:

      Sub ImportTableToExcelBySubject()
      Dim xItem As Object
      Dim xMailItem As MailItem
      Dim xTable As Word.Table
      Dim xDoc As Word.Document
      Dim xExcel As Excel.Application
      Dim xWb As Workbook
      Dim xWs As Worksheet
      Dim I As Integer
      Dim xRow As Integer
      Dim xFileDialog As FileDialog
      On Error Resume Next
      If Application.ActiveExplorer.CurrentFolder.Items.Count = 0 Then Exit Sub
      Set xExcel = New Excel.Application
      Set xFileDialog = xExcel.FileDialog(msoFileDialogFilePicker)
      xFileDialog.Filters.Add "Excel Workbook", "*.xls*", 1
      If xFileDialog.Show = 0 Then Exit Sub
      Set xWb = xExcel.Workbooks.Open(xFileDialog.SelectedItems(1))
      Set xWs = xWb.Worksheets(1)
      xExcel.DisplayAlerts = False
      xRow = 1
      For Each xItem In Application.ActiveExplorer.CurrentFolder.Items
      If xItem.Class = olMail Then
      Set xMailItem = xItem
      If InStr(xMailItem.Subject, "Backup Status today") > 0 Then 'enter the subject into the double quote
      Set xDoc = xMailItem.GetInspector.WordEditor
      For I = 1 To xDoc.Tables.Count
      Set xTable = xDoc.Tables(I)
      xTable.Range.Copy
      xWs.Paste
      xRow = xRow + xTable.Rows.Count + 1
      xWs.Range("A" & CStr(xRow)).Select
      Next
      xMailItem.Display
      End If
      End If
      Next
      xWb.Save
      xExcel.DisplayAlerts = True
      xExcel.Visible = True
      End Sub
      • To post as a guest, your comment is unpublished.
        Blessy · 3 months ago
        Thank you Skyyang. It works. Except it fetches all the mail with "Backup Status today" wherein I want this code to run on mails received today. Have updated your code, but still it copies the table from all the mails received in the past too. Please help.


        Sub ImportTableToExcelBySubject()
        Dim xItem As Object
        Dim xMailItem As MailItem
        Dim xTable As Word.Table
        Dim xDoc As Word.document
        Dim xExcel As Excel.Application
        Dim xWb As Workbook
        Dim xWs As Worksheet
        Dim I As Integer
        Dim xRow As Integer
        Dim xFileDialog As FileDialog
        Dim Drt As Date
        On Error Resume Next
        If Application.ActiveExplorer.CurrentFolder.Items.Count = 0 Then Exit Sub
        Set xExcel = New Excel.Application
        Set xFileDialog = xExcel.FileDialog(msoFileDialogFilePicker)
        xFileDialog.Filters.Add "Excel Workbook", "*.xls*", 1
        If xFileDialog.Show = 0 Then Exit Sub
        Set xWb = xExcel.Workbooks.Open(xFileDialog.SelectedItems(1))
        Set xWs = xWb.Worksheets(1)
        xExcel.DisplayAlerts = False
        xRow = 1
        For Each xItem In Application.ActiveExplorer.CurrentFolder.Items
        If xItem.Class = olMail Then
        Set xMailItem = xItem
        Drt = xMailItem.ReceivedTime
        If Drt <= Date And InStr(xMailItem.Subject, "Backup Status today") > 0 Then 'enter the subject into the double quote
        Set xDoc = xMailItem.GetInspector.WordEditor
        For I = 1 To xDoc.Tables.Count
        Set xTable = xDoc.Tables(I)
        xTable.Range.Copy
        xWs.Paste
        xRow = xRow + xTable.Rows.Count + 1
        xWs.Range("A" & CStr(xRow)).Select
        Next
        xMailItem.Display
        End If
        End If
        Next
        xWb.Save
        xExcel.DisplayAlerts = True
        xExcel.Visible = True
        End Sub
        • To post as a guest, your comment is unpublished.
          skyyang · 2 months ago
          Hi, Blessy,

          If you just need to import the tables with specific subject, you should apply the below VBA code. First, you need to select the email with the subject you need, and then run this code. Please try.

          Sub ImportTableToExcelBySubject()
          Dim xMailItem As MailItem
          Dim xTable As Word.Table
          Dim xDoc As Word.Document
          Dim xExcel As Excel.Application
          Dim xWb As Workbook
          Dim xWs As Worksheet
          Dim I As Integer
          Dim xRow As Integer
          Dim xFileDialog As FileDialog
          On Error Resume Next
          Set xExcel = New Excel.Application
          Set xFileDialog = xExcel.FileDialog(msoFileDialogFilePicker)
          xFileDialog.Filters.Add "Excel Workbook", "*.xls*", 1
          If xFileDialog.Show = 0 Then Exit Sub
          Set xWb = xExcel.Workbooks.Open(xFileDialog.SelectedItems(1))
          Set xWs = xWb.Worksheets(1)
          xExcel.DisplayAlerts = False
          xRow = 1
          For Each xMailItem In Application.ActiveExplorer.Selection
          If InStr(xMailItem.Subject, "Backup Status today") > 0 Then
          Set xDoc = xMailItem.GetInspector.WordEditor
          For I = 1 To xDoc.Tables.Count
          Set xTable = xDoc.Tables(I)
          xTable.Range.Copy
          xWs.Paste
          xRow = xRow + xTable.Rows.Count + 1
          xWs.Range("A" & CStr(xRow)).Select
          Next
          End If
          Next
          xWb.Save
          xExcel.DisplayAlerts = True
          xExcel.Visible = True
          End Sub
          • To post as a guest, your comment is unpublished.
            Blessy · 2 months ago
            Thank you, Skyyang for your response. My whole target is to run the code in outlook VBA so that it searches for mail recieved on "current date" in other words "today" with subject "Backup Status today" and copy the table from that mail to excel in tabular format. Please help on this.. instead of we select that mail, let the code selects the mail and copy the content to excel. is there a way... ? Please help, it will save my day.
  • To post as a guest, your comment is unpublished.
    Blessy · 3 months ago
    Need help, VBA to copy table from outlook mail with specific subject to excel in a specific location

    I receive a mail with subject "Backup Status today" with a table of 2 columns and 6 rows in my Inbox. Trying to write a code to open the mail and copy the table and paste it in excel in a specific location.

    Issue: Code runs fine, no error. Mails opens and also the excel file opens. But the table is not copied. Please help on this.

    Sub Openmail()

    Dim xMailItem As Variant
    Dim olNs As Outlook.NameSpace
    Dim olFldr As Outlook.MAPIFolder
    Dim olItms As Outlook.Items
    Dim xTable As Word.Table
    Dim xDoc As Word.document
    Dim wordApp As Object
    Dim xExcel As Object
    Dim xWb As Workbook
    Dim xWs As Worksheet
    Dim I As Long
    Dim v As Integer
    Dim xRow As Integer
    Dim StrFile$
    On Error Resume Next

    Set olApp = New Outlook.Application
    Set olNs = olApp.GetNamespace("MAPI")
    Set olFldr = olNs.GetDefaultFolder(olFolderInbox)
    Set olItms = olFldr.Items
    Set wordApp = CreateObject("Word.Application")
    Set xExcel = CreateObject("Excel.Application")

    xRow = 1
    I = 1

    For Each xMailItem In olItms
    If Int(xMailItem.ReceivedTime) >= Date Then
    If InStr(xMailItem.Subject, "Backup Status today") > 0 Then
    'xMailItem.Display
    Set xDoc = xMailItem.GetInspector.WordEditor
    For v = 1 To xDoc.Tables.Count
    Set xTable = xDoc.Tables(v)
    xTable.Range.Copy
    StrFile = "C:\Users\priyanka.jeganathan\OneDrive - Accenture\Accenture\Learning\Daily DashBoard Basesheet.xlsx"
    Set xWb = xExcel.Workbooks.Open(StrFile)
    Set xWs = xWb.Worksheets("IRIS Daily")
    xWs.Activate
    xWs.Paste
    xRow = xRow + xTable.Rows.Count + 1
    xWs.Range("A" & CStr(xRow)).Select
    Next
    I = I + 1
    End If
    End If
    Next xMailItem
    xWs.Display
    xWs.Range("A1:A6").ColumnWidth = 43
    xWs.Rows("1:6").RowHeight = 16.5
    Set olFldr = Nothing
    Set olNs = Nothing
    Set olApp = Nothing
    End Sub