Jak na propojení Excelu s Outlookem Jak na propojení Excelu s Outlookem a proč vlastně? Po článku Jak na propojení Excelu s Wordem je další na řadě poštovní aplikace. Na čtyřech příkladech si ukážeme, čím si tyto dvě aplikace z balíčku Microsoft Office mohou být užitečné. Hned na začátku něco, co sám potřebuji velmi často – seznam e-mailových adres, které se potulují v mém Outlooku. 'Tools / References / Microsoft Outlook xx.x Object Library Private Sub OutlookNacistAdresyZAdresare() Dim objOutlook As Object Dim objAddressList As Object Dim objAddressEntry As Object Dim i As Long Dim lngPocetPolozek As Long Dim arrAdresy() Set objOutlook = CreateObject("Outlook.Application") Set objAddressList = objOutlook.Session.AddressLists("Kontakty") Application.ScreenUpdating = False 'počet položek v adresáři lngPocetPolozek = objAddressList.AddressEntries.Count 'dimenzování pole ReDim arrAdresy(1 To lngPocetPolozek, 1 To 2) 'prokaždý záznam v adresáři For Each objAddressEntry In objAddressList.AddressEntries 'počítadlo i=i+1 'jméno arrAdresy(i, 1) = objAddressEntry.Name 'adresa
Excelplus.NET | 1
Jak na propojení Excelu s Outlookem arrAdresy(i, 2) = objAddressEntry.Address 'Microsoft Exchange 'Set objAddressEntryDetail = objAddressEntry.GetExchangeUser Next objAddressEntry 'vložení adres do listu wshAdresy.Cells(1).Resize(lngPocetPolozek, 2) = arrAdresy Application.ScreenUpdating = True Set objAddressList = Nothing Set objOutlook = Nothing End Sub Pokud jsou vaše kontakty uloženy v rámci Exchange, detail kontaktů najdete pod objektem objAddressEntryDetail (PropertyAccessor, GetProperty, schema a Microsoft Exchange Property Tags). To není můj případ a tak není jednoduché se dostat k jiným informacích, než je jméno a adresa. Uvedená procedura má i další háček. Outlook není dostatečně aktivní a ani nemotivuje uživatele v tom, aby odesílatele přidávali do svých adresářů. Takže v momentě, kdy chcete projít vaše kontakty, je v adresáři jednoduše nemáte. Proto nabízím i verzi, která vytahá e-maily z doručených zpráv. 'Tools / References / Microsoft Outlook xx.x Object Library Sub OutlookNacistAdresyZDorucenychMailu() Dim i As Long Dim lngPocetPolozek As Long Dim arrAdresy() Dim objOutlook As Object Dim objNameSpace As Object Dim objFolder As Object Dim objItem As Object Set objOutlook = New Outlook.Application
Excelplus.NET | 2
Jak na propojení Excelu s Outlookem Set objNameSpace = objOutlook.GetNamespace("MAPI") 'olFolderInbox ... 6 Set objFolder = objNameSpace.GetDefaultFolder(olFolderInbox) 'počet položek v adresáři lngPocetPolozek = objFolder.Items.Count 'dimenzování pole ReDim arrAdresy(1 To lngPocetPolozek, 1 To 1) For Each objItem In objFolder.Items 'je položka typu e-mail? 'olMail ... 43 If objItem.Class = olMail Then 'počítadlo i=i+1 'přidání adresy odesílatele do pole arrAdresy(i, 1) = objItem.SenderEmailAddress End If Next objItem Application.ScreenUpdating = False With wshAdresy 'vložení adres do listu .Cells(1).Resize(lngPocetPolozek, 1) = arrAdresy 'odstranění duplicit .Range("A:A").RemoveDuplicates Columns:=1, Header:=xlNo End With 'setřídění listu A-Z With wshAdresy.Sort .SortFields.Clear
Excelplus.NET | 3
Jak na propojení Excelu s Outlookem .SortFields.Add Key:=Range("A1"), SortOn:=xlSortOnValues, _ Order:=xlAscending, DataOption:=xlSortNormal .SetRange Range("A:A") .Header = xlGuess .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With Application.ScreenUpdating = True 'odstranění proměnných z paměti Set objFolder = Nothing Set objNameSpace = Nothing Set objOutlook = Nothing End Sub Po převzetí adres je samozřejmě potřeba řešit duplicity a není na škodu si adresy abecedně seřadit. I tak vám ještě zůstane trocha ruční práce – spam, který prošel, „no reply“ adresy apod. A hodit se vám může i tip na zřetězení. Postačí prostý odkaz na oblast vzorcem, stisk F9 (dojde k nahrazení adresy oblasti za hodnoty) a zbavení se drobného balastu. Položky oddělené středníky lze rovnou aplikovat ve zprávě Outlooku. První adresu věnujte políčku Komu a ostatní umístěte do skryté kopie (tlačítko Kopie a v otevřeném dialogu políčko Skrytá). Hromadné e-maily prosím rozesílejte jen v rozumné míře…
Zřetězení e-mailových adres pro hromadnou korespondenci Přitvrdíme. Co si třeba projít všechny zprávy a vypsat jen takové, které obsahují v předmětu slovo
Excelplus.NET | 4
Jak na propojení Excelu s Outlookem „Excel“? 'Tools / References / Microsoft Outlook xx.x Object Library Sub OutlookNacistZpravyDlePredmetu() Dim i As Long Dim lngPocetPolozek As Long Dim arrPoleData() Dim objOutlook As Object Dim objNameSpace As Object Dim objFolder As Object Dim objItem As Object Set objOutlook = New Outlook.Application Set objNameSpace = objOutlook.GetNamespace("MAPI") 'olFolderInbox ... 6 Set objFolder = objNameSpace.GetDefaultFolder(olFolderInbox) 'aktivace patřičného listu wshZpravy.Activate 'počet položek v adresáři lngPocetPolozek = objFolder.Items.Count 'dimenzování pole ReDim arrPoleData(1 To lngPocetPolozek, 1 To 4) For Each objItem In objFolder.Items 'je položka typu e-mail 'a obsahuje předmět slovo "Excel"? 'olMail ... 43 If (objItem.Class = olMail) And (objItem.Subject Like "*Excel*") Then 'počítadlo i=i+1
Excelplus.NET | 5
Jak na propojení Excelu s Outlookem
'přidání informací do pole 'čas doručení arrPoleData(i, 1) = objItem.ReceivedTime 'jméno arrPoleData(i, 2) = objItem.SenderName 'e-mail arrPoleData(i, 3) = objItem.SenderEmailAddress 'předmět zprávy arrPoleData(i, 4) = objItem.Subject 'obsah 'arrPoleData(i, 5) = objItem.Body 'kopie CC, BCC 'arrPoleData(i, 6) = objItem.CC End If Next objItem 'vložení informací do listu wshZpravy.Cells(1).Resize(lngPocetPolozek, 4) = arrPoleData 'odstranění proměnných z paměti Set objFolder = Nothing Set objNameSpace = Nothing Set objOutlook = Nothing End Sub Něco praktičtějšího? Tak projdeme všechny nepřečtené zprávy, roztřídíme je a uložíme přílohy do složky podle odesílatele. 'Tools / References / Microsoft Outlook xx.x Object Library Private Const cstrCesta As String = "D:\Test\"
Excelplus.NET | 6
Jak na propojení Excelu s Outlookem Sub OutlookUlozeniPrilohDleOdesilatele() Dim cstrCestaPriloha As String Dim objOutlook As Object Dim objNameSpace As Object Dim objFolderInbox As Object Dim objFolderDeletedItems As Object Dim objItem As Object Set objOutlook = New Outlook.Application Set objNameSpace = objOutlook.GetNamespace("MAPI") 'olFolderInbox ... 6, olFolderDeletedItems ... 3 Set objFolderInbox = objNameSpace.GetDefaultFolder(olFolderInbox) Set objFolderDeletedItems = _ objNameSpace.GetDefaultFolder(olFolderDeletedItems) 'pro každou položku v adresáři For Each objItem In objFolderInbox.Items 'je zpráva doposud nepřečtená? If objItem.UnRead Then With objItem.Attachments 'existuje příloha? If .Count > Then 'pro všechny přílohy For i = 1 To .Count 'cstrCesta ke složce odesílatele cstrCestaPriloha = cstrCesta & objItem.SenderName & "\" 'vytvoření (neexistující) složky On Error Resume Next MkDir cstrCestaPriloha
Excelplus.NET | 7
Jak na propojení Excelu s Outlookem 'uložení přílohy .Item(i).SaveAsFile (cstrCestaPriloha & .Item(i).Filename) Next i End If End With 'nastavení atributu přečtené zprávy 'objItem.UnRead = False 'přesun zprávy do složky Odstraněná pošta 'objItem.Move (objFolderDeletedItems) 'odstranění zprávy 'objItem.Delete End If Next objItem 'ukončení seance 'objOutlook.Quit End Sub Všechny dosavadní příklady fungovaly ve směru z Outlooku do Excelu. Poslední úloha bude opačná. Ze seznamu úkolů v Excelu vytvoříme úkol/událost v Outlooku. Níže uvedená procedura je jiná ještě v jedné věci. Ukazuje druhý způsob, jak se odkázat na aplikaci Outlook bez nutnosti reference (metoda CreateObject). Zatímco v předchozích ukázkách s referencemi jsme si mohli dovolit používat konstanty Outlooku a deklarovat objekty i přímo a nejen jako obecný Object, zde to možné není.
Propojení Excel – Outlook – událost Sub OutlookVytvoritUkolUdalost()
Excelplus.NET | 8
Jak na propojení Excelu s Outlookem Dim objOutlook As Object Dim objTaskItem As Object Dim objAppointmentItem As Object Dim intRadek As Integer 'aktivace patřičného listu wshUdalosti.Activate 'volba datového řádku intRadek = 2 'vytvoření instance aplikace Outlook Set objOutlook = CreateObject("Outlook.Application") 'úkol ... olTaskItem ... 3 'Set objTaskItem = objOutlook.CreateItem(3) 'With objTaskItem '
.Subject = Cells(intRadek, 1).Text
'
.StartDate = Cells(intRadek, 2).Value
'
.DueDate = Cells(intRadek, 3).Value
'
.ReminderTime = Cells(intRadek, 4).Value
'
.Body = Cells(intRadek, 5).Text
'
.Save
'End With 'událost ... olAppointmentItem ...1 Set objAppointmentItem = objOutlook.CreateItem(1) With objAppointmentItem 'předmět .Subject = Cells(intRadek, 1).Text 'počáteční datum .Start = Cells(intRadek, 2).Value 'konečné datum .End = Cells(intRadek, 3).Value + 1 'celodenní událost
Excelplus.NET | 9
Jak na propojení Excelu s Outlookem .AllDayEvent = True 'upozornění v minutách před poč. datem .ReminderMinutesBeforeStart = (Cells(intRadek, 2).Value - _ Cells(intRadek, 4).Value) * 1440 'obsah .Body = Cells(intRadek, 5).Text 'místo .Location = Cells(intRadek, 6).Text 'uložení .Save End With 'odstranění objektů z paměti Set objTaskItem = Nothing Set objAppointmentItem = Nothing Set objOutlook = Nothing End Sub
Excelplus.NET | 10
Jak na propojení Excelu s Outlookem
Propojení Excel – Outlook – událost Chcete-li si nastudovat objektový model Outlooku, můžete zavítat na stránky Object model (Outlook VBA reference). Pokud vás to navnadilo podívat se na Outlook blíž, pak jen dobře. Uvědomte si, že i Outlook má události a vy můžete po příchodu zprávy automaticky uložit přílohu a mail zpracovat… Příloha: excel_propojeni_outlook.zip
Excelplus.NET | 11
