Stránka 1 z 1
VBA: konverzní sešit Excel pro Outlook kontakty
Napsal: 19 lis 2012 16:42
od d1amond
Zdravím,
nevěděl by mi někdo naťuknout konverzní sešit v Excel na import kontaktů do Outlook? Neznám objektové knihovny Outlook, proto se ptám. Stačilo by i nastínit např. jméno, email
a skupinu, zbytek už bych si dodělal. Problém možná bude s verzemi, takže bych to potřeboval už od 2003. Předem díky, pokud se někdo najde
Re: VBA: konverzní sešit Excel pro Outlook kontakty
Napsal: 19 lis 2012 17:08
od Uziv00
Jestli jde o to, vybrat z určeného sešitu a listu e-mailové adresy a importovat je do adresního řádku outlooku pro odeslání zprávy všem najednou, tak to umím pomocí vbs.
Re: VBA: konverzní sešit Excel pro Outlook kontakty
Napsal: 19 lis 2012 18:20
od d1amond
Jde o to, dostat je do adresáře.
Re: VBA: konverzní sešit Excel pro Outlook kontakty
Napsal: 19 lis 2012 18:23
od Uziv00
Mrknu, jestli by to šlo. Předpokládám jméno, příjmení, funkce, a jedna buňka s názvem skupiny.Outlook jako objekt ve vbs existuje, ale musím zjistit, jestli se dá dostat do adresáře. Ale nebude to hned :(
Re: VBA: konverzní sešit Excel pro Outlook kontakty
Napsal: 19 lis 2012 18:38
od Uziv00
Upravuji...Určitě to umí FullName a email.address, takže funkce nebude...
Re: VBA: konverzní sešit Excel pro Outlook kontakty
Napsal: 19 lis 2012 19:20
od d1amond
Díky i za ten čas...
Re: VBA: konverzní sešit Excel pro Outlook kontakty
Napsal: 20 lis 2012 21:51
od Uziv00
Ahoj,
takže něco jsem stvořil i to funguje. Nevím ale jestli podle tvých představ.
Je třeba mít xls soubor s kontakty kde musí být něco v buňce A (skript ji testuje na prázdnost), dále v buňce B plné jméno a v buňce C e-mailová adresa.
Skript po spuštění nahraje položky do kontaktů outlooku. Předpokládá se profil Outlook, pokud máš jiný, je třeba to ve skriptu uvést. první řádek tabulky je ignorován.
Kód: Vybrat vše
Const olFolderContacts = 10
Const olContactItem = 2
Dim excApp, excWkb, excWks, olkApp, olkSes, olkFld, olkCon, lngRow
Set olkApp = CreateObject("Outlook.Application")
Set olkSes = olkApp.GetNamespace("MAPI")
'Zde změňte jméno profilu jak potřebujete
olkSes.Logon "Outlook"
Set olkFld = olkSes.GetDefaultFolder(olFolderContacts)
Set excApp = CreateObject("Excel.Application")
'Zde zadejte jméno souboru včetně cesty
Set excWkb = excApp.Workbooks.Open("C:\eeTesting\kontakty.xls")
For Each excWks In excWkb.Sheets
lngRow = 2
Do Until excWks.Cells(lngRow, "A") = ""
Set olkCon = olkFld.Items.Find("[FullName] = '" & excWks.Cells(lngRow, 2) & "'")
If TypeName(olkCon) = "Nothing" Then
Set olkCon = olkApp.CreateItem(olContactItem)
With olkCon
.FullName = excWks.Cells(lngRow, "B")
.Email1Address = excWks.Cells(lngRow, "C")
.Save
End With
End If
lngRow = lngRow + 1
Loop
Next
Set olkCon = Nothing
Set olkFld = Nothing
olkSes.Logoff
Set olkSes = Nothing
Set olkApp = Nothing
Set excWks = Nothing
excWkb.Close False
Set excWkb = Nothing
excApp.Quit
Set excApp = Nothing
msgbox "Import kompletní", vbInformation + vbOKOnly, "Import Contacts"
Jo, ještě dodatek - zkopírovat do notepadu, uložit s příponou .vbs.