Saltar al contenido principal

¿Cómo exportar la tabla del cuerpo del correo electrónico para sobresalir en Outlook?

Cuando recibe un correo electrónico que contiene algunas tablas en el cuerpo, a veces, es posible que deba exportar todas las tablas del cuerpo del mensaje a una hoja de cálculo de Excel. Normalmente, puede copiar y pegar las tablas en la hoja de trabajo, pero aquí hablaré sobre un método útil para resolver este trabajo cuando se necesitan exportar varias tablas.

Exporte todas las tablas del cuerpo del mensaje de Outlook a la hoja de cálculo de Excel con código VBA

Exporte todas las tablas del cuerpo del mensaje de Outlook a la hoja de cálculo de Excel con código VBA

Aplique el siguiente código VBA para exportar todas las tablas de un cuerpo de mensaje a la hoja de cálculo de Excel.

1. Abra el mensaje de que desea exportar las tablas y luego mantenga presionada la tecla ALT + F11 teclas para abrir el Microsoft Visual Basic para aplicaciones ventana.

2. Hacer clic recuadro > Móduloy pegue el siguiente código en el Módulo ventana.

Código de VBA: exporte todas las tablas del cuerpo del mensaje a la hoja de trabajo de Excel:

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 exportar tablas a Excel 1

3. Después de pegar el código anterior, todavía en el Microsoft Visual Basic para aplicaciones ventana, haga clic Herramientas > Referencias para ir a la Referencias-Proyecto1 cuadro de diálogo y verifique Biblioteca de objetos de Microsoft Word y Biblioteca de objetos de Microsoft Excel opciones del Referencias disponibles cuadro de lista, ver captura de pantalla:

doc exportar tablas a Excel 2

4. Luego haga clic OK para salir del cuadro de diálogo, y ahora, por favor F5 clave para ejecutar el código, todas las tablas en el cuerpo del mensaje se han exportado a un nuevo libro de trabajo como se muestra en la siguiente captura de pantalla:

doc exportar tablas a Excel 3

Las mejores herramientas de productividad de oficina

Kutools para Outlook - Más de 100 potentes funciones para potenciar tu perspectiva

🤖 Asistente de correo AI: Correos electrónicos profesionales instantáneos con magia de IA: respuestas geniales con un clic, tono perfecto y dominio multilingüe. ¡Transforme el correo electrónico sin esfuerzo! ...

📧 Automatización de correo electrónico: Fuera de la oficina (disponible para POP e IMAP)  /  Programar envío de correos electrónicos  /  CC/CCO automático según reglas al enviar correo electrónico  /  Reenvío automático (reglas avanzadas)   /  Agregar saludo automáticamente   /  Divida automáticamente correos electrónicos de múltiples destinatarios en mensajes individuales ...

📨 Gestión de correo electrónico: Recuperar correos electrónicos fácilmente  /  Bloquear correos electrónicos fraudulentos por sujetos y otras personas  /  Eliminar correos electrónicos duplicados  /  Búsqueda Avanzada  /  Consolidar carpetas ...

📁 Archivos adjuntos profesionales: Guardar lote  /  Separación de lotes  /  Comprimir por lotes  /  Ahorro automático   /  Desconexión automática  /  Autocompresión ...

???? Interfaz mágica: 😊Más emojis bonitos y geniales   /  Aumente su productividad en Outlook con vistas con pestañas  /  Minimizar Outlook en lugar de cerrar ...

👍 Maravillas con un clic: Responder a todos los archivos adjuntos entrantes  /   Correos electrónicos antiphishing  /  🕘Mostrar zona horaria del remitente ...

👩🏼‍🤝‍👩🏻 Contactos y calendario: Agregar por lotes contactos de correos electrónicos seleccionados  /  Dividir un grupo de contactos en grupos individuales  /  Eliminar recordatorios de cumpleaños ...

Mas de Características 100 ¡Espere su exploración! Haga clic aquí para descubrir más.

Leer Mas       Descargar gratis      Comprar
 

 

Comments (19)
No ratings yet. Be the first to rate!
TinaP1966
TinaP1966
This comment was minimized by the moderator on the site
re. Export all tables from Outlook message body to Excel worksheet with VBA code - i followed the instructions and it looked like it worked but where does the excel workbook go? I cant find it! (sorry, very new to this)
Reply
Report
0
0
skyyang
skyyang     TinaP1966
This comment was minimized by the moderator on the site
Hello,
The vba code will export the tables to a new opened workbook, and after getting the result, you just need to save the workbook to your desired location.
please have a try, hope this can help you!
Reply
Report
0
0
Sanesh
Sanesh
This comment was minimized by the moderator on the site
i need to extract a table of data i receive every hour to a saved file

this doesn't work for me
Reply
0
0
Sanesh
Sanesh
This comment was minimized by the moderator on the site
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?
Reply
0
0
arshad
arshad
This comment was minimized by the moderator on the site
Even I receive many email with specific subject which I want to extract those tables in that email... help needed
Reply
0
0
skyyang
skyyang     arshad
This comment was minimized by the moderator on the site
Hello, arshad,
Do you mean to export all tables from the messages with the same subject into a worksheet?
Reply
Report
0
0
Arshad
Arshad
This comment was minimized by the moderator on the site
This VBA code is not working for me... after run not getting exported in excel
Reply
0
0
smith23
smith23
This comment was minimized by the moderator on the site
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?
Reply
Report
0
0
Krishnan
Krishnan     smith23
This comment was minimized by the moderator on the site
Same issue here as well. I tried to set the objects to nothing within each loop,but still it is not working.
Reply
0
0
PatrickM
PatrickM     smith23
This comment was minimized by the moderator on the site
Having the same issue here. No solution yet but thought I would let you know you are not alone.
Reply
0
0
Blessy
Blessy
This comment was minimized by the moderator on the site
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
Reply
Report
0
0
skyyang
skyyang     Blessy
This comment was minimized by the moderator on the site
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
Reply
Report
1
0
Blessy
Blessy     skyyang
This comment was minimized by the moderator on the site
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
Reply
Report
0
0
Ananya
Ananya     Blessy
This comment was minimized by the moderator on the site
What reference/ object library needs to be activated in excel? I am actually new to VBA and learning .
Reply
0
0
skyyang
skyyang     Blessy
This comment was minimized by the moderator on the site
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
Reply
Report
0
0
Blessy
Blessy     skyyang
This comment was minimized by the moderator on the site
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.
Reply
Report
0
0
Blessy
Blessy
This comment was minimized by the moderator on the site
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
Reply
0
0
Blessy
Blessy
This comment was minimized by the moderator on the site
How to open a mail with specific subject and copy the table in spreadsheet with a specific name. Please help.
Reply
0
0
Shreya
Shreya
This comment was minimized by the moderator on the site
This works great! Thank you very much
Reply
0
0
There are no comments posted here yet
Please leave your comments in English
Guest
Posting as Guest
×
Rate this post:
Reset
0   Characters
Suggested Locations