Salt la conținutul principal

Cum se exportă tabelul corpului de e-mail pentru a excela în Outlook?

Când primiți un e-mail care conține unele tabele în corp, uneori, poate fi necesar să exportați toate tabelele din corpul mesajului într-o foaie de lucru Excel. În mod normal, puteți copia și lipi tabelele în foaia de lucru, dar, aici, voi vorbi despre o metodă utilă pentru rezolvarea acestei sarcini atunci când sunt necesare mai multe tabele pentru a fi exportate.

Exportați toate tabelele din corpul mesajului Outlook în foaia de lucru Excel cu cod VBA


Exportați toate tabelele din corpul mesajului Outlook în foaia de lucru Excel cu cod VBA

Vă rugăm să aplicați următorul cod VBA pentru a exporta toate tabelele dintr-un corp de mesaj în foaia de lucru Excel.

1. Deschideți mesajul că doriți să exportați tabelele, apoi țineți apăsat butonul ALT + F11 tastele pentru a deschide Microsoft Visual Basic pentru aplicații fereastră.

2. Clic Insera > Moduleși lipiți următorul cod în Module fereastră.

Cod VBA: Exportați toate tabelele din corpul mesajului în foaia de lucru 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 tabele de export pentru Excel 1

3. După lipirea codului de mai sus, încă în Microsoft Visual Basic pentru aplicații fereastră, faceți clic pe Instrumente > Referinte a merge la Referințe-Proiect1 casetă de dialog și bifați Biblioteca de obiecte Microsoft Word și Biblioteca de obiecte Microsoft Excel opțiuni din Referințe disponibile casetă listă, vezi captura de ecran:

doc tabele de export pentru Excel 2

4. Apoi apasa OK pentru a ieși din caseta de dialog și acum, vă rog F5 tasta pentru a rula codul, toate tabelele din corpul mesajului au fost exportate într-un nou registru de lucru, după cum se arată în următoarea captură de ecran:

doc tabele de export pentru Excel 3


Cele mai bune instrumente de productivitate de birou

Kutools pentru Outlook - Peste 100 de funcții puternice pentru a vă supraalimenta Outlook

🤖 AI Mail Assistant: E-mailuri profesionale instantanee cu magie AI--un singur clic pentru răspunsuri geniale, ton perfect, stăpânire în mai multe limbi. Transformați e-mailurile fără efort! ...

📧 Automatizare e-mail: În afara biroului (disponibil pentru POP și IMAP)  /  Programați trimiterea de e-mailuri  /  CC/BCC automat după reguli la trimiterea e-mailului  /  Redirecționare automată (Reguli avansate)   /  Adăugare automată felicitare   /  Împărțiți automat e-mailurile cu mai mulți destinatari în mesaje individuale ...

📨 Managementul e-mail: Amintește-ți cu ușurință e-mailurile  /  Blocați e-mailurile înșelătorii de către subiecți și alții  /  Ștergeți e-mailurile duplicate  /  Cautare Avansata  /  Consolidați foldere ...

📁 Atașamente ProSalvați în serie  /  Detașare lot  /  Compresă în loturi  /  Salvare automata   /  Detașare automată  /  Comprimare automată ...

🌟 Magia interfeței: 😊Mai multe emoji drăguțe și cool   /  Îmbunătățiți-vă productivitatea Outlook cu vizualizările cu file  /  Minimizați Outlook în loc să închideți ...

???? Minuni cu un singur clic: Răspundeți tuturor cu atașamentele primite  /   E-mailuri anti-phishing  /  🕘Afișați fusul orar al expeditorului ...

👩🏼‍🤝‍👩🏻 Contacte și calendar: Adăugați în lot contacte din e-mailurile selectate  /  Împărțiți un grup de contact în grupuri individuale  /  Eliminați mementouri de ziua de naștere ...

Peste 100 Caracteristici Așteaptă explorarea ta! Click aici pentru a descoperi mai multe.

 

 

Comments (19)
No ratings yet. Be the first to rate!
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)
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!
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
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?
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
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?
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
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?
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.
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.
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
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
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
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 .
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
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.
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
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.
This comment was minimized by the moderator on the site
This works great! Thank you very much
There are no comments posted here yet
Please leave your comments in English
Posting as Guest
×
Rate this post:
0   Characters
Suggested Locations