Importar datos de Outlook a Excel

Con VBA de Excel podemos contactar con Outlook para devolver datos. En este ejemplo vamos a importar algunos datos de los Contactos.

Objetos utilizados

Para contactar con Outlook desde Excel podemos utilizar el objeto GetNameSpace de la MAPI - Messaging Application Programming Interface.

Luego, el método GetDefaultFolder nos deja acceder a las carpetas de Outlook, por ejemplo el de los Contactos.

Parámetro	Carpeta
3	Deleted Items (Elementos elimindos)
4	Outbox (Bandeja de salida)
5	Sent Items (Elementos enviados)
6	Inbox (Bandeja de entrada)
9	Calendar (Calendario)
10	Contacts (Contactos)
11	Journal (Diario)
12	Notes (Notas)
13	Tasks (Tareas)
16	Drafts (Borrador)

El código


Sub ImportarContactos()

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(olFolderContacts)

'rotulos
Cells(1, 1) = "Nombre"
Cells(1, 2) = "E-mail"
Cells(1, 3) = "Título"
Cells(1, 4) = "Empresa"
Cells(1, 5) = "Tel (casa)"
Cells(1, 6) = "Tel (móbil)"
Cells(1, 7) = "Tel (trabajo)"
Cells(1, 8) = "Fax (trabajo)"
Cells(1, 9) = "Dir. (empresa)"
Cells(1, 10) = "Postal (empresa)"
Cells(1, 11) = "Ciudad (empresa)"
Cells(1, 12) = "País (empresa)"
Cells(1, 13) = "Dir. (casa)"
Cells(1, 14) = "Postal (casa)"
Cells(1, 15) = "Ciudad (casa)"
Cells(1, 16) = "País (Casa)"

'importar 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

'eliminar variables de los objetos
Set olContact = Nothing
Set olContacts = Nothing
Set olApp = Nothing

'ordenar lista por Nombre
Cells.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess

End Sub