Import: Outlook-kontakter till Excel
I det här exemplet kommer jag att visa hur du med hjälp av ett makro kan tanka över Contacts från Microsoft Outlook direkt in i ett kalkylblad i Excel. Resultatet av körningen ser ut så här:
Innan vi går in på detaljerna så vill jag nämna att det finns fler (och kanske enklare) sätt att exportera Outlook-data, men exemplet vill visa på hur man från Excel kan koppla upp sig mot Outlook.
Metod för att koppla upp sig mot Outlook
För att låta Excel koppla upp sig mot Outlook så kan vi använda oss av metoden GetNameSpace (som är en del av MAPI – Messaging Application Programming Interface).
Egenskapen GetDefaultFolder() tar oss till foldrarna i Outlook
Via egenskapen GetDefaultFolder kan vi komma åt den folder i Outlook som vi är intresserade av. Koden ser ut som följer:
Set olContacts = olApp.GetNamespace("MAPI").GetDefaultFolder(10) |
Du väljer folder i parentesen efter GetDefaultFolder. I detta exemplet väljer vi GetDefaultFolder(10) som motsvarar Contacts-foldern. Följande foldrar finns tillgängliga i Outlook:
Parameter | Outlook-folder |
3 | Deleted Items |
4 | Outbox |
5 | Sent Items |
6 | Inbox |
9 | Calendar |
10 | Contacts |
11 | Journal |
12 | Notes |
13 | Tasks |
16 | Drafts |
VBA-referens till Outlook-objekten anges
Som vanligt så måste vi i VBA-editorn ange en referens till ovanstående Outlook-objekt.
Det gör du via Tools – References, se bilden nedan.
VBA-koden som importerar Outlook-contacts till Excel
Nedanstående kod körs från ett kalkylblad och för över Outlook-informationen till aktivt arbetsblad. Alternativt kan det här VBA-programmet läggas i Personal Macro Workbook för generell åtkomst från vilken arbetsbok som helst.
Sub Importera_Outlook_Contacts() Dim olApp As Outlook.Application Dim olContacts As Outlook.MAPIFolder Dim olContact As Outlook.ContactItem Dim i As Integer Set olApp = New Outlook.Application Set olContacts = olApp.GetNamespace("MAPI").GetDefaultFolder(10) 'kolumnrubriker Cells(1, 1) = "Namn" Cells(1, 2) = "E-mail" Cells(1, 3) = "Titel" Cells(1, 4) = "Företag" Cells(1, 5) = "Tel (hem)" Cells(1, 6) = "Tel (mobil)" Cells(1, 7) = "Tel (arbete)" Cells(1, 8) = "Fax (arbete)" Cells(1, 9) = "Adress (företag)" Cells(1, 10) = "Postnr (företag)" Cells(1, 11) = "Stad (företag)" Cells(1, 12) = "Land (företag)" Cells(1, 13) = "Adress (hem)" Cells(1, 14) = "Postnr (hem)" Cells(1, 15) = "Stad (hem)" Cells(1, 16) = "Land (hem)" 'importerar contact-items For i = 2 To olContacts.Items.Count If TypeOf olContacts.Items.Item(i) Is Outlook.ContactItem Then Set olContact = olContacts.Items.Item(i) Cells(i, 1) = olContact.FullName Cells(i, 2) = olContact.Email1Address Cells(i, 3) = olContact.JobTitle Cells(i, 4) = olContact.CompanyName Cells(i, 5) = olContact.HomeTelephoneNumber Cells(i, 6) = olContact.MobileTelephoneNumber Cells(i, 7) = olContact.BusinessTelephoneNumber Cells(i, 8) = olContact.BusinessFaxNumber Cells(i, 9) = olContact.BusinessAddressStreet Cells(i, 10) = olContact.BusinessAddressPostalCode Cells(i, 11) = olContact.BusinessAddressCity Cells(i, 12) = olContact.BusinessAddressCountry Cells(i, 13) = olContact.HomeAddressStreet Cells(i, 14) = olContact.HomeAddressPostalCode Cells(i, 15) = olContact.HomeAddressCity Cells(i, 16) = olContact.HomeAddressCountry End If Next 'släcker ned objekt-variablerna Set olContact = Nothing Set olContacts = Nothing Set olApp = Nothing 'sorterar listan efter namn Cells.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess End Sub |
Säkerhetsåtgärd i Outlook
Körning av programmet kommer att ge en ruta som frågar om vi vill ge åtkomst till Outlook under en begränsad tid. Vi måste svara JA på den här frågan för att åtkomst till Outlook skall kunna skapas.