Importera kontakter från Ms Outlook

Import av kontakter från MS Outlook

Här demonstreras hur vi kan automatiskt hämta önskade uppgifter från kontaktregistret i Outlook.

Om vi har byggt upp vårt kundregister i "Kontakter" så kanske vi vill nyttja dessa uppgifter i samband med att vi utför något arbete i Excel.

För att få snabbare tillgång till uppgifterna är det att rekommendera att det sker i två steg: Först importerar vi data till Excel och därefter bygger vi upp en lösning i Excel-miljön mha av t ex uppslagsfunktionerna.

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 importerar ö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).

"Kontakter" innehåller kontakter men också sändlistor. För att förhindra att sändlistorna importeras filtreras dessa bort (se procedur nedan).

Option Explicit

Sub Importera_Kontakter()

   Dim olApp As Outlook.Application

   Dim olNamespace As Outlook.NameSpace

   Dim olFolder As Outlook.MAPIFolder

   Dim olColItems As Outlook.Items

   Dim olItem As Object

   Dim strDummy As String

   Dim i As Long

   Application.ScreenUpdating = False

   With Worksheets("Kundlistan")

      .Activate

      .Range("A1").CurrentRegion.Clear

   End With

   With ActiveSheet

      .Cells(1, 1).Value = "Företag /Privatperson"

      .Cells(1, 2).Value = "Gatuadress"

      .Cells(1, 3).Value = "Postnummer"

      .Cells(1, 4).Value = "Ort"

      .Cells(1, 5).Value = "Kontaktperson"

      .Cells(1, 6).Value = "E-postadress"

      With Range("A1:F1")

         .Font.Bold = True

         .Font.ColorIndex = 10

         .Font.Size = 11

      End With

   End With

   Set olApp = New Outlook.Application

   Set olNamespace = olApp.GetNamespace("MAPI")

   Set olFolder = olNamespace.GetDefaultFolder(10)

   Set olColItems = olFolder.Items

   i = 2

   For Each olItem In olColItems

      If TypeName(olItem) = "ContactItem" Then

         With olItem

            If InStr(olItem.CompanyName, strDummy) > 0 Then

               Cells(i, 1).Value = .CompanyName

               Cells(i, 2).Value = .BusinessAddressStreet

               Cells(i, 3).Value = .BusinessAddressPostalCode

               Cells(i, 4).Value = .BusinessAddressCity

               Cells(i, 5).Value = .FullName

               Cells(i, 6).Value = .Email1Address

            Else

               Cells(i, 1).Value = .FullName

               Cells(i, 2).Value = .HomeAddressStreet

               Cells(i, 3).Value = .HomeAddressPostalCode

               Cells(i, 4).Value = .HomeAddressCity

               Cells(i, 5).Value = .FullName

               Cells(i, 6).Value = .Email1Address

            End If

         End With

         i = i + 1

      End If

   Next olItem

   Set olItem = Nothing

   Set olColItems = Nothing

   Set olFolder = Nothing

   Set olNamespace = Nothing

   Set olApp = Nothing

   'När alla poster är importerade sker en sortering från A-Ö på

   'basis av variabeln "Företagsnamn/Privatperson"

   Range("A2", Cells(2, 6).End(xlDown)).Sort Key1:=Range("A2"), _

Order1:=xlAscending

   Range("A:F").EntireColumn.AutoFit

   Application.Application.ScreenUpdating = False

   MsgBox "Kundlistan uppdaterad!", vbInformation

End Sub

Vill vi inte importera 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!

Nackdelen är dock att vi här inte kan bestämma vilka variabler som ska importeras för varje kontakt utan alla följer med.