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.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46

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 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.

1
2
3
4
5
6
7
8
9
10
11
12
13

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í

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.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17

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

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í).

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56

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

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.

1
2
3
4
5
6
7
8
9
10
11
12
13
14

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

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.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46

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.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54

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.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87

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í:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17

'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

Uložit článek jako PDF