Jak odeslat e-mail z Excelu

Jedním z věčných témat je potřeba odesílání informací přímo z Excelu prostřednictvím e-mailu. Opětovně jej uvádím na svých stránkách i já. Ukážeme si, jak poslat část tabulky, sešit jako přílohu i e-mail úplně nezávislý na Microsoft Office. Nástrojem nám budiž VBA.

Metoda FollowHyperlink
Jmenovaná metoda využívá výchozího poštovního klienta. Programově umí naplnit dialog nové zprávy. SendKeys pak může simulovat stisk klávesy Odeslat (Alt+A, dříve Alt+S). Její užití není podmíněno posláním sešitu jako celku v příloze.

Sub ExcelFollowHyperlink()

    Dim rngOblast As Range
    Dim rngBunka As Range
    Dim strAdresat As String
    Dim strPredmet As String
    Dim strObsah As String
    Dim strRet As String
   
    'náhrada vbLf
    Const cstrLf As String = "%0A"

    'adresát
    strAdresat = "nekdo@nekde.cz"
   
    'předmět
    strPredmet = "Výpis z listu"
   
    'zdroj obsahu
    Set rngOblast = Range("rngObsah")

    'hlavička obsahu
    strObsah = rngOblast.Parent.Name & cstrLf

    'načtení adres a obsahů jednotlivých buněk oblasti
    For Each rngBunka In rngOblast
        strObsah = strObsah & cstrLf & rngBunka.Address(0, 0) & ": " & _
            rngBunka.Text
    Next rngBunka

    'sestavení řetězce pro metodu FollowHyperlink
    strRet = "mailto:" & strAdresat & "?"
    'předmět
    strRet = strRet & "subject=" & strPredmet & "&"
    'obsah
    strRet = strRet & "body=" & strObsah

    'odeslání e-mailu
    ActiveWorkbook.FollowHyperlink (strRet)
   
    'simulované potvrzení dialogu (Odeslat, ALT+A)
    'Microsoft Outlook 2010 CZ
    Application.Wait (Now + TimeValue("0:00:05"))
    SendKeys "%a", True
   
End Sub
Metoda FollowHyperlink

Metoda FollowHyperlink

Metoda SendMail
Tato metoda patří asi k nejznámějším, ale také činí největší potíže. Sešit je v ní posílán jako příloha a veškerá činnost podléhá vcelku přísným bezpečnostním opatřením, díky čemuž nelze úlohu plně zautomatizovat.

Sub ExcelSendMail()
   
    'aktivní sešit jako příloha
   
    Dim aKomu()
   
    'adresáti
    aKomu = Array("nekdo@nekde.cz", "info@firma.org")
   
    'odeslání s uvedením předmětu zprávy
    ActiveWorkbook.SendMail aKomu, "Výpis listu"
   
End Sub

První z níže uvedených obrázků ukazuje systémový dialog při odesílání zprávy přes Microsoft Outlook. V průběhu let se měnil, tlačítka přišla o klávesovou zkratku, tlačítko Povolit není výchozí a navíc je zpřístupněno po uplynutí několika sekund. Řadu let se programátoři snaží tento dialog obejít. Pokud vím, ze strany Microsoftu je cesta hodně trnitá a svého času byla podmíněna používáním Microsoft Exchange. Druhý obrázek ukazuje výsledek klepnutí na tlačítko Odepřít či uzavření dialogu – chybovou zprávu.

Metoda SendMail - zabezpečení

Metoda SendMail – zabezpečení

Metoda SendMail

Metoda SendMail

Dialog SendMail
Následující příklad využívá vestavěného dialogu pro odesílání pošty. Bohužel, v tomto případě se mi nepodařilo zprovoznit automatické potvrzení dialogu přes SendKeys. Nezkoušel jsem cestu odeslání klávesové zkratky přes API.

Sub ExcelDialogSendMail()

    'aktivní sešit jako příloha
   
    Dim aKomu()
   
    aKomu = Array("nekdo@nekde.cz", "info@firma.org")
   
    'simulované potvrzení dialogu (Odeslat, ALT+A)
    'Microsoft Outlook 2010 CZ
    'neproběhne
    SendKeys "%a"
   
    'předvyplnění a zobrazení okna se zprávou
    Application.Dialogs(xlDialogSendMail).Show aKomu, "Výpis listu"
   
End Sub
Dialog SendMail

Dialog SendMail

API funkce
Při posílání e-mailu můžete sáhnout i po API funkci, konkrétně ShellExecute (popravdě nejsem si úplně jistý, proč v poznámkách nemám uveden příklad na VBA funkci Shell, ale pravděpodobně jsem narazil na nějaký problém při jejím užití).

Private Const SW_SHOWNORMAL As Long = 1

Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteW" _
    (ByVal hWnd As Long, ByVal lpOperation As Long, ByVal lpFile As Long, ByVal _
    lpParameters As Long, ByVal lpDirectory As Long, ByVal nShowCmd As Long) As Long

Sub ExcelAPI()

    Dim strObsah As String
    Dim strURL As String
    Dim strAdresat As String
    Dim strPredmet As String
    Dim strAdresatCC As String
    Dim strAdresatBCC As String
    Dim rngOblast As Range
    Dim rngBunka As Range
   
    'náhrada vbLf
    Const cstrLf As String = "%0A"

    'adresát
    strAdresat = "nekdo@nekde.cz"
   
    'kopie
    strAdresatCC = "schranka@email.com"
   
    'skrytá kopie
    strAdresatBCC = "info@firma.org"
   
    'zdroj pro obsah zprávy
    Set rngOblast = Range("rngObsah")
   
    'předmět
    strPredmet = "Výpis listu"

    'zpracování obsahu
    strObsah = rngOblast.Parent.Name & cstrLf
   
    For Each rngBunka In rngOblast
        strObsah = strObsah & cstrLf & rngBunka.Address(0, 0) & ": " & vbTab & _
            rngBunka.Text
    Next rngBunka

    'sestavení řetězce pro funkci ShellExecute
    strURL = "mailto:" & strAdresat & "?cc=" & strAdresatCC & "&bcc=" & _
        strAdresatBCC & "&subject=" & strPredmet & "&body=" & strObsah

    'nasazení API funkce
    ShellExecute 0&, 0&, StrPtr(strURL), 0&, 0&, SW_SHOWNORMAL

    'simulované potvrzení dialogu (Odeslat, ALT+A)
    'Microsoft Outlook 2010 CZ
    Application.Wait (Now + TimeValue("0:00:05"))
    SendKeys "%a", True

End Sub
API funkce ShellExecute

API funkce ShellExecute

Pozn. V původní verzi tohoto článku byla užita ANSI verze funkce ShellExecute, nyní již pracujeme s Unicode verzí (viz alias ShellExecuteW v deklaraci, parametry Long, StrPtr a správný obsah buňky B5 v těle e-mailu)

Panel Obálka (Envelope)
Dialog nové zprávy umí Excel zobrazovat i v rámci svého hlavního okna. Jedná se o panel reprezentující jakousi hlavičku formuláře. Kromě toho je také důkazem, že starší panely nástrojů lze zobrazovat v prostředí Excelu 2007 a novějším.

Sub ExcelPanelObalka()
   
    'aktivní sešit jako příloha
   
    'odesílaný z podokna Excelu
    ActiveWorkbook.EnvelopeVisible = True
   
End Sub

Sub ExcelZavritPanelObalka()

    ActiveWorkbook.EnvelopeVisible = False
   
End Sub
Panek Obálka (Envelope)

Panek Obálka (Envelope)

Pozn. Teoreticky je k dispozici přístup k panelu přes CommandBars(„Envelope“). Tento postup je ale nespolehlivý.

Objektový model Microsoft Outlook
Komfortní práci s odesíláním pošty zajistí pochopitelně přímé napojení na objektový model Outlooku. První příklad ukazuje obecný postup posílání elektronické zprávy včetně příloh.

Sub ExcelOutlookPriloha()

    'Tools / References / Microsoft Outlook x.x Object Library

    Dim OutApp As Outlook.Application
    Dim OutMail As Outlook.MailItem
   
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(olMailItem)

    With OutMail
   
        'adresát
        .To = "nekdo@nekde.cz"
       
        'kopie pro
        .CC = "schranka@email.com"
       
        'skrytá kopie pro
        .BCC = "info@firma.org"
       
        'předmět zprávy
        .Subject = "Předmět zprávy"
       
        'text zprávy
        .Body = "1. řádek zprávy" & Chr(13) & "2. druhý řádek zprávy"
       
        'aktivní (uložený) sešit jako příloha
        .Attachments.Add ActiveWorkbook.FullName
       
        'jiná příloha
        .Attachments.Add ActiveWorkbook.Path & "\soubor.txt"
       
        'zobrazení okna se zprávou (není nutné)
        .Display
       
        'odeslání zprávy
        '.Send
       
    End With
   
    'uvolnění z paměti
    Set OutMail = Nothing
    Set OutApp = Nothing
   
End Sub
Microsoft Outlook - příloha

Microsoft Outlook – příloha

Jak jistě víte, v e-mailu se může objevit i obsah v HTML formátu. Tuto možnost využívá následující procedura, která odesílá aktivní list přímo v těle zprávy.

Sub ExcelOutlookHTML()

    'Tools / References / Microsoft Outlook x.x Object Library

    Dim OutApp As Outlook.Application
    Dim OutMail As Outlook.MailItem
   
    Dim strCestaSoubor As String
    Dim strObsahHTML As String

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(olMailItem)

    'uložení listu do HTML podoby
    strCestaSoubor = ActiveWorkbook.Path & "\temp.htm"
    ActiveWorkbook.PublishObjects.Add(xlSourceSheet, _
            strCestaSoubor, ActiveSheet.Name).Publish (True)

    'načtení HTML kódu uloženého listu
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set txt = fso.GetFile(strCestaSoubor).OpenAsTextStream(1, -2)
    strObsahHTML = txt.ReadAll
    txt.Close

    With OutMail
   
        'adresát
        .To = "nekdo@nekde.cz"
       
        'kopie pro
        .CC = "schranka@email.com"
       
        'skrytá kopie pro
        .BCC = "info@firma.org"
       
        'předmět zprávy
        .Subject = "Předmět zprávy"
       
        'HTML obsah zprávy
        .HTMLBody = strObsahHTML
       
        'zobrazení okna se zprávou (není nutné)
        .Display
       
        'odeslání zprávy
        '.Send
       
    End With
   
    'uvolnění z paměti
    Set OutMail = Nothing
    Set OutApp = Nothing
   
End Sub
Microsoft Outlook - HTML obsah

Microsoft Outlook – HTML obsah

Objektový model Outlooku je pochopitelně možné využít v daleko větším měřítku – práce s kontakty, složkami, kalendářem atd. Makra směřující k událostem Outlooku (nová příchozí zpráva, navázání pravidel, …) je už zpravidla nutné směřovat přímo do Outlooku, kde si můžete také vytvořit formuláře coby šablony zpráv.

CDO
Ve Windows již dlouho existuje jedna cesta, jak odeslat tichý e-mail a dokonce s přílohou bez vazby na poštovního klienta. Využijeme přitom systémovou knihovnu cdosys.dll (CDO je zkratkou Collaboration Data Objects). CDO je řešením pro klientské aplikace, které v určitém bodu pracovního procesu odešlou informaci zaměstnanci, jenž má v procesu pokračovat. Může se jednat kupříkladu o proces schvalování. Bezpodmínečně nutný je SMTP server a existující poštovní účet. Dříve šlo blafovat ve vlastnosti .From, v níž se mohl objevit jiný odesílatel. Kupříkladu Seznam.cz toto již přímo zakazuje a Gmail.com ignoruje.

Sub ExcelCDO()

    Dim iMsg As Object
    Dim iConf As Object
    Dim strBody As String
    Dim Flds As Object

    'Windows 2000 a novější

    'objekty CDO
    Set iMsg = CreateObject("CDO.Message")
    Set iConf = CreateObject("CDO.Configuration")

    'nastavení konfigurace
    iConf.Load -1
    Set Flds = iConf.Fields

    strConf = "http://schemas.microsoft.com/cdo/configuration/"

    'příklad pro Seznam.cz
    With Flds
   
        .Item(strConf & "sendusing") = 2
       
        'SMTP server
        .Item(strConf & "smtpserver") = "smtp.seznam.cz"
       
        'port
        .Item(strConf & "smtpserverport") = 25
       
        .Item(strConf & "smtpauthenticate") = 1
       
        'pro e-mail ucet@seznam.cz
        .Item(strConf & "sendusername") = "ucet"
        .Item(strConf & "sendpassword") = "heslo"
       
        .Update
       
    End With

    'text v těle zprávy
    strBody = "1. řádek zprávy" & Chr(13) & Chr(10) & "2. druhý řádek zprávy"

    With iMsg
   
        'konfigurace
        Set .configuration = iConf
       
        'adresát
        .To = "nekdo@nekde.cz"
       
        'kopie
        .CC = ""
       
        'skrytá kopie
        .BCC = ""
       
        'odesílatel
        .From = "ucet@seznam.cz"
       
        'předmět
        .Subject = "Text v předmětu zprávy"

        'HTML obsah zprávy
        '.HTMLBody= ...

        'HTML stránka na internetu
        '.CreateMHTMLBody "http://www.excelplus.net/data/cnb-denni-kurz.php"

        'lokální HTML soubor
        '.CreateMHTMLBody "file://C:/test.htm"
        'textový obsah zprávy
        .TextBody = strBody
       
        'příloha (mezeru v názvu nahrazujte "%20")
        .AddAttachment ActiveWorkbook.Path & "\soubor.txt"
       
        'odeslání
        .Send
       
    End With

    'odstranění spojení
    Set iMsg = Nothing
    Set iConf = Nothing

End Sub
CDO - příchozí e-mail

CDO – příchozí e-mail

Uvědomte si prosím, že heslo uvedené ve VBA není nijak chráněno a heslo projektu je snadno prolomitelné.

Pro Gmail.com je nastavení následující:

    'příklad pro Gmail.com
    With Flds
   
        .Item(strConf & "sendusing") = 2
        .Item(strConf & "smtpserver") = "smtp.gmail.com"
        .Item(strConf & "smtpserverport") = 25 '465, 587
        .Item(strConf & "smtpauthenticate") = 1
        .Item(strConf & "smtpusessl") = 1
        .Item(strConf & "smtpconnectiontimeout") = 60
       
        'pro e-mail ucet@gmail.com
        .Item(strConf & "sendusername") = "ucet@gmail.com"
        .Item(strConf & "sendpassword") = "heslo"
       
        .Update
       
    End With

Pozn. Gmail ve výchozím stavu odesílání z nedůvěryhodných aplikací nedovoluje. Naopak, na daný účet dorazí varování o využití schránky (spolu s návodem, jak lze nastavení změnit).

Gmail - změna nastavení

Gmail – změna nastavení

Častokrát jsem v nejen v rámci CDO (viz užití CreateMHTMLBody) musel diskutovat otázku špatně zobrazeného HTML obsahu s kódováním UTF-8. Pravdou je, že ať už jsem použil SMTP Seznamu nebo Googlu, tak na jejich straně je kódování v pořádku. Nicméně bez pardonů pitomý Outlook má problém s jeho zobrazením. Zatímco u odchozí pošty si můžete pohrát s nastavením, pro příchozí maily nejspíš neexistuje způsob, jak ho UTF-8 naučit (snad by to zvládl Exchange). Přitom pokud si obsah otevřete v Internet Exploreru (na kterém je podle všeho závislý), dopadne vše dobře. Tády-dády-dá.

Příloha
excel_mail.zip

Klikni a stahuj!