Först publicerad: 2009-06-03

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:

resultat-import-contacts

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:

ParameterOutlook-folder
3Deleted Items
4Outbox
5Sent Items
6Inbox
9Calendar
10Contacts
11Journal
12Notes
13Tasks
16Drafts

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-referenser-outlook

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.

access-to-outlook