Note: The other languages of the website are Google-translated. Back to English
Inloggen  \/ 
x
or
x
Registreer  \/ 
x

or

Hoe exporteer ik de hoofdtekst van een e-mail om uit te blinken in Outlook?

Wanneer u een e-mail ontvangt die enkele tabellen in de hoofdtekst bevat, moet u soms alle tabellen van de berichttekst naar een Excel-werkblad exporteren. Normaal gesproken kunt u de tabellen naar het werkblad kopiëren en plakken, maar hier zal ik het hebben over een handige methode om deze taak op te lossen wanneer er meerdere tabellen moeten worden geëxporteerd.

Exporteer alle tabellen van Outlook-berichttekst naar Excel-werkblad met VBA-code


Exporteer alle tabellen van Outlook-berichttekst naar Excel-werkblad met VBA-code

Pas de volgende VBA-code toe om alle tabellen van één berichttekst naar Excel-werkblad te exporteren.

1. Open het bericht dat u de tabellen wilt exporteren en houd vervolgens de ALT + F11 toetsen om de te openen Microsoft Visual Basic voor toepassingen venster.

2. Klikken Invoegen > Moduleen plak de volgende code in het Module venster.

VBA-code: exporteer alle tabellen van de berichttekst naar het Excel-werkblad:

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 tabellen exporteren naar Excel 1

3. Na het plakken van de bovenstaande code, nog steeds in het Microsoft Visual Basic voor toepassingen venster klikt Toolbox > Referenties naar de Referenties-Project1 dialoogvenster en vink aan Microsoft Word-objectbibliotheek als Microsoft Excel-objectbibliotheek opties uit de Beschikbare referenties keuzelijst, zie screenshot:

doc tabellen exporteren naar Excel 2

4. Dan klikken OK om het dialoogvenster te verlaten, en nu alstublieft F5 sleutel om de code uit te voeren, alle tabellen in de berichttekst zijn geëxporteerd naar een nieuwe werkmap zoals in de volgende schermafbeelding:

doc tabellen exporteren naar Excel 3


Kutools voor Outlook - Brengt 100 geavanceerde functies naar Outlook en maakt het werk veel gemakkelijker!

  • Auto CC / BCC volgens regels bij het verzenden van e-mail; Automatisch doorsturen Meerdere e-mails op maat; Auto antwoord zonder uitwisselingsserver, en meer automatische functies ...
  • BCC-waarschuwing - toon bericht wanneer u alle probeert te beantwoorden als uw e-mailadres in de BCC-lijst staat; Herinner bij ontbrekende bijlagen, en meer herinneren functies ...
  • Beantwoorden (alle) met alle bijlagen in het e-mailgesprek; Beantwoord veel e-mails in seconden; Begroeting automatisch toevoegen wanneer antwoord; Datum toevoegen aan onderwerp ...
  • Hulpmiddelen voor bijlagen: beheer alle bijlagen in alle e-mails, Automatisch loskoppelen, Alles comprimeren, Alles hernoemen, Alles opslaan ... Snel rapport, Tel geselecteerde e-mails...
  • Krachtige ongewenste e-mails op maat; Verwijder dubbele e-mails en contacten... Stel u in staat om slimmer, sneller en beter te doen in Outlook.
shot kutools outlook kutools tabblad 1180x121
shot kutools vooruitzichten kutools plus tabblad 1180x121
 
Say something here...
symbols left.
You are guest
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.
    Sanesh · 2 years ago
    i need to extract a table of data i receive every hour to a saved file

    this doesn't work for me
  • To post as a guest, your comment is unpublished.
    Sanesh · 2 years ago
    Hi, i receive an email every hour with a table that i need to automatically send to a spreadsheet in a folder, will this code above work for that?
  • To post as a guest, your comment is unpublished.
    arshad · 2 years 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 · 2 years 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 · 2 years 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.
    smith23 · 2 years 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.
      Krishnan · 2 years ago
      Same issue here as well. I tried to set the objects to nothing within each loop,but still it is not working.
    • To post as a guest, your comment is unpublished.
      PatrickM · 2 years 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 · 2 years 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 · 2 years 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 · 2 years 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.
          Ananya · 2 years ago
          What reference/ object library needs to be activated in excel? I am actually new to VBA and learning .
        • To post as a guest, your comment is unpublished.
          skyyang · 2 years 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 years 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 · 2 years 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
  • To post as a guest, your comment is unpublished.
    Blessy · 2 years ago
    How to open a mail with specific subject and copy the table in spreadsheet with a specific name. Please help.
  • To post as a guest, your comment is unpublished.
    Shreya · 2 years ago
    This works great! Thank you very much