Export av kontakter till MS Outlook

 

Här demonstreras en teknik för att exportera kontakter från Excel till kontaktregistret i Outlook.

Det kan i vissa situationer vara enklare att uppdatera / underhålla registret genom att göra arbetet i XL och därefter exportera till Outlook.

MS Outlook är ett systemresurskrävande program (åtminstone på mina datorer) varför det kan uppfattas att det tar lång tid vid hämtning av data. Ett tips är därför att du öppnar Outlook först och därefter exporterar önskad data.

Innan proceduren körs måste en referens sättas till Outlooks objektbibliotek. Det sker på följande sätt:

1. Öppna VB-Editorn i Excel.

2. Välj kommandot Verktyg | Referenser...

3. Bocka för Microsoft Outlook x.x Object Library.

Genom att sätta en referens till en specifik version av Outlooks Object Library ställs kravet, vid distribution, på att mottagarna också har tillgång till det. Istället kan en mer generell referens skapas genom att i procedurerna ange följande:

Dim OLObj as Object

Set OLObj = CreateObject("Outlook.Application")

Den mest påtagliga nackdelen är att det inte går lika fort jämfört med ovanstående ansats.


"Kontakter" ska inte förväxlas med en personlig mapp eller en personlig adressbok i Outlooks struktur. 

Den tillhör kategorin inbyggda mappar och ingår i användarens postsystem. Den är en s k MAPI-folder. Det gör att vi dels måste anropa NameSpace i Outlook och dels definiera "Kontakter" som ett MAPIfolder-objekt. NameSpace används för att skapa kontakt med redan existerande objekt (se procedur nedan). 

För att förhindra dubbletter i kontaktregistret filtreras dessa bort i samband med att data exporteras (se procedur nedan). Här finns många lösningar att tillgå.

 


Option Explicit
 Sub Exportera_Kontakter()
 Dim olApp As Outlook.Application
Dim olNamespace As Outlook.NameSpace
Dim olFolder As Outlook.MAPIFolder
Dim olColItems As Outlook.Items
Dim olItem As Outlook.ContactItem
Dim i As Long
Set olApp = New Outlook.Application
Set olNamespace = olApp.GetNamespace("MAPI")
Set olFolder = olNamespace.GetDefaultFolder(10)
Set olColItems = olFolder.Items

Application.ScreenUpdating = False

j = 0
j = Range("A2", Cells(2, 1).End(xlDown)).Count + 1

For i = 2 To j
If olColItems.Find("[CompanyName]= " & CStr(Cells(i, 1).Value)) _
  Is Nothing Then
     Set olItem = olColItems.Add
     With olItem
           .CompanyName = Cells(i, 1).Value
           .BusinessAddressStreet = Cells(i, 2).Value
           .BusinessAddressPostalCode = Cells(i, 3).Value
           .BusinessAddressCity = Cells(i, 4).Value
           .FullName = Cells(i, 5).Value
           .Email1Address = Cells(i, 6).Value
           .Save
     End With
  End If
Next i
Set olItem = Nothing
Set olColItems = Nothing
Set olFolder = Nothing
Set olNamespace = Nothing
Set olApp = Nothing

Application.ScreenUpdating = True

MsgBox "Kontaktregistret uppdaterat!", vbInformation
 End Sub

 

Vill vi inte exportera mha VBA kan vi istället göra det manuellt:

1. Öppna MS Outlook.

2. Välj kommandot Arkiv | Importera och exportera...

3. Följ anvisningarna i guiden.

4. Klart!

Tips: