Note: The other languages of the website are Google-translated. Back to English

Jak exportovat tabulku těla e-mailu do aplikace Excel?

Když obdržíte e-mail, který obsahuje některé tabulky v těle, někdy budete možná muset exportovat všechny tabulky z těla zprávy do listu aplikace Excel. Normálně můžete tabulky zkopírovat a vložit do listu, ale zde budu hovořit o užitečné metodě řešení této úlohy, když je potřeba exportovat více tabulek.

Exportujte všechny tabulky z těla zprávy aplikace Outlook do listu aplikace Excel s kódem VBA


Exportujte všechny tabulky z těla zprávy aplikace Outlook do listu aplikace Excel s kódem VBA

Použijte prosím následující kód VBA k exportu všech tabulek z jednoho těla zprávy do listu aplikace Excel.

1. Otevřete zprávu, kterou chcete exportovat, a poté podržte klávesu ALT + F11 klávesy pro otevření Microsoft Visual Basic pro aplikace okno.

2, klikněte Vložit > Modula vložte následující kód do Modul okno.

Kód VBA: Exportujte všechny tabulky z těla zprávy do listu aplikace 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

tabulky exportu dokumentů do aplikace Excel 1

3. Po vložení výše uvedeného kódu stále do Microsoft Visual Basic pro aplikace okno, klepněte na tlačítko Tools > Reference přejděte na Reference-Project1 dialogové okno a zkontrolujte Objektová knihovna Microsoft Word a Objektová knihovna Microsoft Excel možnosti z Dostupné reference seznam, viz screenshot:

tabulky exportu dokumentů do aplikace Excel 2

4. Pak klikněte na tlačítko OK tlačítko pro opuštění dialogového okna a nyní prosím F5 klíč ke spuštění kódu, všechny tabulky v těle zprávy byly exportovány do nového sešitu, jak ukazuje následující snímek obrazovky:

tabulky exportu dokumentů do aplikace Excel 3


Kutools pro Outlook - přináší do aplikace Outlook 100 pokročilých funkcí a usnadňuje práci!

  • Auto CC / BCC podle pravidel při odesílání e-mailů; Automatické předávání Více e-mailů podle zvyku; Automatická odpověď bez serveru Exchange a dalších automatických funkcí ...
  • Varování BCC - zobrazit zprávu, když se pokusíte odpovědět všem pokud je vaše e-mailová adresa v seznamu BCC; Připomenout, když chybí přílohya další připomínající funkce ...
  • Odpovědět (Vše) Se všemi přílohami v e-mailové konverzaci; Odpovězte na mnoho e-mailů během několika sekund; Automatické přidání pozdravu při odpovědi; Přidat datum do předmětu ...
  • Nástroje pro přílohy: Spravujte všechny přílohy ve všech e-mailech, Automatické odpojení, Komprimovat vše, Přejmenovat vše, Uložit vše ... Rychlá zpráva, Počítat vybrané e-maily...
  • Výkonné nevyžádané e-maily podle zvyku; Odeberte duplicitní e-maily a kontakty... Umožní vám dělat chytřejší, rychlejší a lepší v Outlooku.
záběr kutools outlook kutools tab 1180x121
shot kutools outlook kutools plus karta 1180x121
 
Komentáře (17)
Zatím žádné hodnocení. Buďte první, kdo ohodnotí!
Tento komentář byl moderátorem webu minimalizován
Tohle funguje skvěle! Děkuji mnohokrát
Tento komentář byl moderátorem webu minimalizován
Jak otevřít e-mail s konkrétním předmětem a zkopírovat tabulku do tabulky s konkrétním názvem. Prosím pomozte.
Tento komentář byl moderátorem webu minimalizován
Potřebujete pomoc, VBA zkopírovat tabulku z Outlook mailu s konkrétním předmětem do excelu na konkrétním místě

Dostávám e-mail s předmětem "Stav zálohy dnes" s tabulkou o 2 sloupcích a 6 řádcích ve složce Doručená pošta. Pokuste se napsat kód pro otevření pošty a zkopírovat tabulku a vložit ji do Excelu na konkrétní místo.

Problém: Kód běží dobře, žádná chyba. Otevře se pošta a otevře se také soubor aplikace Excel. Tabulka se ale nekopíruje. Prosím o pomoc.

Sub Openmail()

Dim xMailItem jako variantu
Dim olNs jako Outlook.NameSpace
Dim olFldr jako Outlook.MAPIFolder
Dim olItms jako Outlook.Items
Dim xTable jako Word.Table
Dim xDoc jako Word.document
Ztlumit wordApp jako objekt
Dim xExcel jako objekt
Dim xWb jako sešit
Dim xWs jako pracovní list
Dim I As Long
Dim v As Integer
Dim xRow jako celé číslo
Dim StrFile$
On Error Resume Next

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

xRow = 1
I = 1 XNUMX

Pro každou xMailItem v olItms
If Int(xMailItem.ReceivedTime) >= Date Then
Pokud InStr(xMailItem.Subject, "Stav zálohy dnes") > 0 Pak
'xMailItem.Display
Nastavit xDoc = xMailItem.GetInspector.WordEditor
Pro 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"
Nastavit xWb = xExcel.Workbooks.Open(StrFile)
Nastavit xWs = xWb.Worksheets("IRIS Daily")
xWs.Aktivovat
xWs.Vložit
xRow = xRow + xTable.Rows.Count + 1
xWs.Range("A" & CStr(xRow)).Vyberte
další
I = I + 1
End If
End If
Další xMailItem
xWs.Display
xWs.Range("A1:A6").ColumnWidth = 43
xWs.Rows("1:6").RowHeight = 16.5
Nastavte olFldr = Nic
Nastavte olNs = Nic
Nastavte olApp = Nic
End Sub
Tento komentář byl moderátorem webu minimalizován
Potřebovat pomoc. Jsem nováček a zkusil jsem kód VBA zkopírovat tabulku z pošty aplikace Outlook s konkrétním předmětem do aplikace Excel na konkrétním místě

Denně dostávám e-mail s předmětem "Stav zálohy dnes" a hledám kód, jak otevřít tento e-mail, zkopírovat tabulku a vložit tabulku v excelu na konkrétní místo.

Problém: Kód běží dobře, žádná chyba. Pošta se otevře a Excel se otevře, ale tabulka se nezkopíruje. Nejsem si jistý, kde jsem udělal chybu. Prosím pomozte.

Sub Openmail()

Dim xMailItem jako variantu
Dim olNs jako Outlook.NameSpace
Dim olFldr jako Outlook.MAPIFolder
Dim olItms jako Outlook.Items
Dim xTable jako Word.Table
Dim xDoc jako Word.document
Ztlumit wordApp jako objekt
Dim xExcel jako objekt
Dim xWb jako sešit
Dim xWs jako pracovní list
Dim I As Long
Dim v As Integer
Dim xRow jako celé číslo
Dim StrFile$
On Error Resume Next

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

xRow = 1
I = 1 XNUMX

Pro každou xMailItem v olItms
If Int(xMailItem.ReceivedTime) >= Date Then
Pokud InStr(xMailItem.Subject, "Stav zálohy dnes") > 0 Pak
'xMailItem.Display
Nastavit xDoc = xMailItem.GetInspector.WordEditor
Pro 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"
Nastavit xWb = xExcel.Workbooks.Open(StrFile)
Nastavit xWs = xWb.Worksheets("IRIS Daily")
xWs.Aktivovat
xWs.Vložit
xRow = xRow + xTable.Rows.Count + 1
xWs.Range("A" & CStr(xRow)).Vyberte
další
I = I + 1
End If
End If
Další xMailItem
xWs.Display
xWs.Range("A1:A6").ColumnWidth = 43
xWs.Rows("1:6").RowHeight = 16.5
Nastavte olFldr = Nic
Nastavte olNs = Nic
Nastavte olApp = Nic
End Sub
Tento komentář byl moderátorem webu minimalizován
Dobrý den, Blessy,
Pokud chcete otevřít e-mail s konkrétním předmětem a exportovat tabulky z těla zprávy do souboru aplikace Excel, může vám pomoci následující kód VBA, zkuste prosím:

Sub ImportTableToExcelBySubject()
Dim xItem As Object
Dim xMailItem jako MailItem
Dim xTable jako Word.Table
Dim xDoc jako Word.Document
Dim xExcel jako Excel.Application
Dim xWb jako sešit
Dim xWs jako pracovní list
Dim I As Integer
Dim xRow jako celé číslo
Dim xFileDialog jako FileDialog
On Error Resume Next
Pokud Application.ActiveExplorer.CurrentFolder.Items.Count = 0, pak Exit Sub
Nastavit xExcel = New Excel.Application
Nastavit xFileDialog = xExcel.FileDialog(msoFileDialogFilePicker)
xFileDialog.Filters.Add "Sešit Excel", "*.xls*", 1
Pokud xFileDialog.Show = 0, pak Exit Sub
Nastavit xWb = xExcel.Workbooks.Open(xFileDialog.SelectedItems(1))
Nastavit xWs = xWb.Worksheets(1)
xExcel.DisplayAlerts = False
xRow = 1
Pro každou položku xItem v Application.ActiveExplorer.CurrentFolder.Items
If xItem.Class = olMail Then
Nastavit xMailItem = xItem
If InStr(xMailItem.Subject, "Stav zálohy dnes") > 0 Pak 'zadejte předmět do dvojité uvozovky
Nastavit xDoc = xMailItem.GetInspector.WordEditor
Pro I = 1 To xDoc.Tables.Count
Nastavit xTable = xDoc.Tables(I)
xTable.Range.Copy
xWs.Vložit
xRow = xRow + xTable.Rows.Count + 1
xWs.Range("A" & CStr(xRow)).Vyberte
další
xMailItem.Display
End If
End If
další
xWb.Uložit
xExcel.DisplayAlerts = True
xExcel.Visible = Pravda
End Sub
Tento komentář byl moderátorem webu minimalizován
Děkuji Skyyang. Funguje to. Kromě toho, že načte veškerou poštu se „Stavem zálohy dnes“, kde chci, aby se tento kód spouštěl na poštách přijatých dnes. Aktualizovali jste svůj kód, ale stále kopíruje tabulku ze všech e-mailů přijatých v minulosti. Prosím pomozte.


Sub ImportTableToExcelBySubject()
Dim xItem As Object
Dim xMailItem jako MailItem
Dim xTable jako Word.Table
Dim xDoc jako Word.document
Dim xExcel jako Excel.Application
Dim xWb jako sešit
Dim xWs jako pracovní list
Dim I As Integer
Dim xRow jako celé číslo
Dim xFileDialog jako FileDialog
Dim Drt jako datum
On Error Resume Next
Pokud Application.ActiveExplorer.CurrentFolder.Items.Count = 0, pak Exit Sub
Nastavit xExcel = New Excel.Application
Nastavit xFileDialog = xExcel.FileDialog(msoFileDialogFilePicker)
xFileDialog.Filters.Add "Sešit Excel", "*.xls*", 1
Pokud xFileDialog.Show = 0, pak Exit Sub
Nastavit xWb = xExcel.Workbooks.Open(xFileDialog.SelectedItems(1))
Nastavit xWs = xWb.Worksheets(1)
xExcel.DisplayAlerts = False
xRow = 1
Pro každou položku xItem v Application.ActiveExplorer.CurrentFolder.Items
If xItem.Class = olMail Then
Nastavit xMailItem = xItem
Drt = xMailItem.ReceivedTime
If Drt <= Date And InStr(xMailItem.Subject, "Stav zálohy dnes") > 0 Pak 'zadejte předmět do dvojité uvozovky
Nastavit xDoc = xMailItem.GetInspector.WordEditor
Pro I = 1 To xDoc.Tables.Count
Nastavit xTable = xDoc.Tables(I)
xTable.Range.Copy
xWs.Vložit
xRow = xRow + xTable.Rows.Count + 1
xWs.Range("A" & CStr(xRow)).Vyberte
další
xMailItem.Display
End If
End If
další
xWb.Uložit
xExcel.DisplayAlerts = True
xExcel.Visible = Pravda
End Sub
Tento komentář byl moderátorem webu minimalizován
Ahoj, Blessy,

Pokud potřebujete pouze importovat tabulky s konkrétním předmětem, měli byste použít níže uvedený kód VBA. Nejprve musíte vybrat e-mail s předmětem, který potřebujete, a poté spustit tento kód. Zkuste to prosím.

Sub ImportTableToExcelBySubject()
Dim xMailItem jako MailItem
Dim xTable jako Word.Table
Dim xDoc jako Word.Document
Dim xExcel jako Excel.Application
Dim xWb jako sešit
Dim xWs jako pracovní list
Dim I As Integer
Dim xRow jako celé číslo
Dim xFileDialog jako FileDialog
On Error Resume Next
Nastavit xExcel = New Excel.Application
Nastavit xFileDialog = xExcel.FileDialog(msoFileDialogFilePicker)
xFileDialog.Filters.Add "Sešit Excel", "*.xls*", 1
Pokud xFileDialog.Show = 0, pak Exit Sub
Nastavit xWb = xExcel.Workbooks.Open(xFileDialog.SelectedItems(1))
Nastavit xWs = xWb.Worksheets(1)
xExcel.DisplayAlerts = False
xRow = 1
Pro každou položku xMailItem v Application.ActiveExplorer.Selection
Pokud InStr(xMailItem.Subject, "Stav zálohy dnes") > 0 Pak
Nastavit xDoc = xMailItem.GetInspector.WordEditor
Pro I = 1 To xDoc.Tables.Count
Nastavit xTable = xDoc.Tables(I)
xTable.Range.Copy
xWs.Vložit
xRow = xRow + xTable.Rows.Count + 1
xWs.Range("A" & CStr(xRow)).Vyberte
další
End If
další
xWb.Uložit
xExcel.DisplayAlerts = True
xExcel.Visible = Pravda
End Sub
Tento komentář byl moderátorem webu minimalizován
Děkuji, Skyyang za vaši odpověď. Celý můj cíl je spustit kód v aplikaci Outlook VBA tak, aby hledal poštu přijatou v „aktuální datum“ jinými slovy „dnes“ s předmětem „Stav zálohy dnes“ a zkopíroval tabulku z této pošty do excelu v tabulkovém formátu. Prosím, pomozte s tím... místo toho, abychom vybrali tuto poštu, nechte kód vybrat poštu a zkopírovat obsah do excelu. existuje způsob...? Prosím pomozte, zachrání mi to den.
Tento komentář byl moderátorem webu minimalizován
Jakou knihovnu referencí/objektů je třeba aktivovat v Excelu? Jsem vlastně nováčkem ve VBA a učím se.
Tento komentář byl moderátorem webu minimalizován
Našel jsem s tím chybu, kterou jsem nedokázal vyřešit.

Pokud vícekrát vyberu dva e-maily, jeden s jednou tabulkou a druhý se třemi tabulkami, a spustím kód, Outlook se zhroutí. Ale všiml jsem si, že je velmi specifické pro objednávku, že e-maily jsou zpočátku vybrány.

1. Pokud například nejprve kliknu na e-mail se třemi tabulkami a poté na e-mail s jednou tabulkou se stisknutou klávesou Ctrl, kód běží bez chyby.

2. Pokud nejprve udělám číslo 1, pak znovu vyberu e-maily, tentokrát klikněte na e-mail s jednou tabulkou, poté se stisknutou klávesou Ctrl a klikněte na e-mail se třemi tabulkami, také se spustí bez chyby

3. Pokud nyní zavřu a restartuji Outlook a nejprve kliknu na e-mail s jednou tabulkou a poté se stisknutou klávesou Ctrl a klepnu na e-mail se třemi tabulkami, Outlook spadne.

Také jsem si všiml, že když se to zhroutí, udělá to po zkopírování/vložení druhé tabulky a předtím, než udělá třetí. Ve skutečnosti se ani nedostane do 'For I = 1 To xDoc.Tables.Count', aby získal třetí tabulku.

Tabulky mají 43 řádků a 7 sloupců. V e-mailech není jiný text a všechna data jsem z tabulek odstranil, takže s údaji v nich nesouvisí. Zkoušel jsem odstranit řádky a v určitém okamžiku to začne fungovat, ale nejsem si jistý, co mi to říká.

Ví někdo, proč se to děje?
Tento komentář byl moderátorem webu minimalizován
Tady máte stejný problém. Zatím žádné řešení, ale myslel jsem, že vám dám vědět, že nejste sami.
Tento komentář byl moderátorem webu minimalizován
Stejný problém i zde. Snažil jsem se nastavit objekty na nic v každé smyčce, ale stále to nefunguje.
Tento komentář byl moderátorem webu minimalizován
Tento kód VBA mi nefunguje... po spuštění se neexportuje do excelu
Tento komentář byl moderátorem webu minimalizován
Dokonce i já dostávám mnoho e-mailů s konkrétním předmětem, ze kterých chci extrahovat ty tabulky v tom e-mailu... potřebuji pomoc
Tento komentář byl moderátorem webu minimalizován
Dobrý den, Arshade,
Máte na mysli exportovat všechny tabulky ze zpráv se stejným předmětem do listu?
Tento komentář byl moderátorem webu minimalizován
Ahoj, každou hodinu dostávám e-mail s tabulkou, kterou musím automaticky odeslat do tabulky ve složce, bude na to fungovat výše uvedený kód?
Tento komentář byl moderátorem webu minimalizován
Potřebuji extrahovat tabulku dat, která dostávám každou hodinu, do uloženého souboru

tohle mi nefunguje
Zatím zde nejsou žádné komentáře
Zanechat své připomínky
Odesílání jako host
×
Ohodnoťte tento příspěvek:
0   Postavy
Doporučená umístění

Sociální sítě

Copyright © 2009 - www.extendoffice.com. | Všechna práva vyhrazena. Poháněno ExtendOffice. | |. | Sitemap
Microsoft a logo Office jsou ochranné známky nebo registrované ochranné známky společnosti Microsoft Corporation ve Spojených státech a / nebo jiných zemích.
Chráněno Sectigo SSL