Přejít k hlavnímu obsahu

Jak exportovat hlavní text e-mailu aplikace Outlook do tabulky aplikace Excel?

Autor: Siluvia Naposledy změněno: 2020-10-30

Pokud chcete exportovat vybraný hlavní text e-mailu z tabulky aplikace Outlook do aplikace Excel, může vám pomoci metoda v tomto článku.

Exportujte hlavní text e-mailu aplikace Outlook do tabulky aplikace Excel s kódem VBA


Exportujte hlavní text e-mailu aplikace Outlook do tabulky aplikace Excel s kódem VBA<

Spusťte níže uvedený kód VBA a exportujte vybraný text e-mailu aplikace Outlook do aplikace Excel.

1. Otevřete e-mail, vyberte text e-mailu, který chcete exportovat do tabulky aplikace Excel, a poté stiskněte Další + F11 klávesy pro otevření Microsoft Visual Basic pro aplikace okno.

2. V Microsoft Visual Basic pro aplikace okno, klepněte na tlačítko Vložit > Modul. A pak zkopírujte níže uvedený kód VBA do okna Kód.

Kód VBA: exportujte hlavní text e-mailu aplikace Outlook do tabulky aplikace Excel

Sub ExportToExcel()
Dim xExcel As Excel.Application
Dim xWb As Workbook
Dim xWs As Worksheet
Dim xInspector As Inspector
Dim xItem As Object
Dim xMailItem As MailItem
Dim xDoc As Document
Dim xShell As Object
Dim xFilePath As String
On Error Resume Next
    Set xShell = CreateObject("Shell.Application")
    Set xFolder = xShell.BrowseForFolder(0, "Select a Folder:", 0, 0)
    If TypeName(xFolder) = "Nothing" Then Exit Sub
    Set xFolderItem = xFolder.Self
    xFilePath = xFolderItem.Path & "\"
    Set xItem = Outlook.Application.ActiveExplorer.Selection.item(1)
    If xItem.Class <> olMail Then Exit Sub
    Set xMailItem = xItem
    Set xInspector = xMailItem.GetInspector
    Set xDoc = xInspector.WordEditor
    xDoc.Application.Selection.Range.Copy
    xInspector.Close olDiscard
    Set xExcel = New Excel.Application
    Set xWb = xExcel.Workbooks.Add
    Set xWs = xWb.Sheets.item(1)
    xExcel.Visible = False
    xWs.Activate
    xWs.Paste
    xWs.SaveAs xFilePath & "Email body.xlsx"
    xWb.Close True
    xExcel.Quit
    Set xWs = Nothing
    Set xWb = Nothing
    Set xExcel = Nothing
End Sub

Poznámka: V kódu, “E-mail body.xlsx„Je název sešitu, který vytvoříte s vybraným textem hlavního e-mailu. Můžete to změnit podle toho, co potřebujete.

3. cvaknutí Tools > Reference. Pak zkontrolujte obě Objektová knihovna Microsoft Excel a Objektová knihovna Microsoft Word krabice v Reference - projekt dialogové okno. Viz snímek obrazovky:

4. Pak a Procházet složku Zobrazí se dialogové okno, vyberte složku pro uložení sešitu a klikněte na ikonu OK .

Nyní sešit s názvem „email tělo”Je vytvořen a uložen do určené složky. Otevřete sešit a uvidíte, že vybraný text e-mailu se exportuje do Listu 1 sešitu.


Nejlepší nástroje pro produktivitu v kanceláři

Kutools pro aplikaci Outlook - Více než 100 výkonných funkcí, které doplní váš Outlook

🤖 AI Mail Assistant: Okamžité profesionální e-maily s magií umělé inteligence – jedním kliknutím získáte geniální odpovědi, perfektní tón, vícejazyčné ovládání. Transformujte e-maily bez námahy! ...

???? Automatizace e-mailu: Mimo kancelář (k dispozici pro POP a IMAP)  /  Naplánujte odesílání e-mailů  /  Automatická kopie/skrytá kopie podle pravidel při odesílání e-mailu  /  Automatické přeposílání (pokročilá pravidla)   /  Automatické přidání pozdravu   /  Automaticky rozdělte e-maily pro více příjemců na jednotlivé zprávy ...

📨 Email management: Snadné vyvolání e-mailů  /  Blokujte podvodné e-maily podle předmětů a dalších  /  Odstranit duplicitní e-maily  /  pokročilé vyhledávání  /  Konsolidovat složky ...

📁 Přílohy ProDávkové uložení  /  Dávkové odpojení  /  Dávková komprese  /  Automaticky uložit   /  Automatické odpojení  /  Automatické komprimování ...

???? Rozhraní Magic: 😊 Více pěkných a skvělých emotikonů   /  Zvyšte produktivitu své aplikace Outlook pomocí zobrazení s kartami  /  Minimalizujte aplikaci Outlook namísto zavírání ...

???? Zázraky na jedno kliknutí: Odpovědět všem s příchozími přílohami  /   E-maily proti phishingu  /  🕘Zobrazit časové pásmo odesílatele ...

👩🏼‍🤝‍👩🏻 Kontakty a kalendář: Dávkové přidání kontaktů z vybraných e-mailů  /  Rozdělit skupinu kontaktů na jednotlivé skupiny  /  Odeberte připomenutí narozenin ...

Přes 100 Vlastnosti Očekávejte svůj průzkum! Kliknutím sem zobrazíte další informace.

Více       Stažení zdarma      Nákup
 

 

Comments (4)
No ratings yet. Be the first to rate!
This comment was minimized by the moderator on the site
this work but in one email only what if in folder theres a multiple email thats need to be extracted in excel?
This comment was minimized by the moderator on the site
Você vai precisar implementar o código fazendo um Looping, com um FOR por exemplo:

Sub lerEmails()

' Criando a aplicação do Outlook
Dim objOutlook As Object
Set objOutlook = CreateObject("Outlook.Application")

' Criando um Namespace, que seria uma sessão no Outlook
Dim objNSpace As Object
Set objNSpace = objOutlook.GetNamespace("MAPI")

' Cria um objeto com a pasta Inbox do Outlook
Dim minhaPasta As Object
Set minhaPasta = objNSpace.GetDefaultFolder(olFolderInbox)

Dim i As Long
Dim itemPasta As Object

i = 2 'Linha que vai começar preenchendo na planilha

' Percorrer todos os itens dentro da pasta
For Each itemPasta In minhaPasta.Items

If itemPasta.Class = olMail Then
Dim objEmail As Outlook.MailItem
Set objEmail = itemPasta

Cells(i, 1).Value = objEmail.SenderEmailAddress
Cells(i, 2).Value = objEmail.To
Cells(i, 3).Value = objEmail.Subject
Cells(i, 4).Value = objEmail.ReceivedTime
Cells(i, 5).Value = objEmail.Body
Cells(i, 5).WrapText = False

End If
i = i + 1

Next

Set objEmail = Nothing
Set objOutlook = Nothing
Set objNSpace = Nothing
Set minhaPasta = Nothing

End Sub
This comment was minimized by the moderator on the site
Hi the code only returned directly, into the excel and not the body of the email, may I know why was that??
This comment was minimized by the moderator on the site
same issue for me as well
There are no comments posted here yet
Please leave your comments in English
Posting as Guest
×
Rate this post:
0   Characters
Suggested Locations