VBA: Importando los contactos de Outlook a Excel.

Seguramente alguna vez has necesitado extraer información de tu Lista de contactos de Outlook, y hayas tenido que recurrir a la exportación en formato .xlsx desde Microsoft Outlook.
Hoy emplearemos una macro para Excel que nos permite importar la información de los contactos desde Excel.

Para ello insertamos nuestro código en un módulo estándar de nuestro proyecto de VBA desde el editor de VB...

Sub Importar_Contactos_Outlook()
'definimos las variables de Outlook como Objects.
Dim olApp As Object
Dim olNamespace As Object
Dim olFolder As Object
Dim olConItems As Object
Dim olItem As Object

'Objetos a usar de nuestro Libro de Excel
Dim wbBook As Workbook
Dim wsSheet As Worksheet
'asignamos valor a los objetos.
Set wbBook = ThisWorkbook           'nuestro libro de trabajo
Set wsSheet = wbBook.Sheets(1)      'la Hoja1 de nuestro libro será el destino de la importación

'Location in the imported contact list.
Dim filaContacto As Long

'Añadimos y formateamos la cabecera de nuestro destino...
With wsSheet
    'primero limpiamos la Hoja destino..
    .Range("A1").CurrentRegion.Clear
    'ahora añadimos la cabecera o rótulos de encabezado...
    .Cells(1, 1).Value = "Nombre de Empresa"
    .Cells(1, 2).Value = "Nombre Completo para mostrar"
    .Cells(1, 3).Value = "Dirección E-mail"
    ' y damos formato....
    With .Range("A1:C1")
        .Font.Bold = True
        .Font.Color = vbRed
        .Font.Size = 11
    End With
End With

wsSheet.Activate

'Configuramos las variables necesarias de Outlook
'empleando el IMAP (=MAPI)
'y la carpeta por defecto de outlook para los contactos...
Set olApp = CreateObject("Outlook.Application")
Set olNamespace = olApp.GetNamespace("MAPI")
Set olFolder = olNamespace.GetDefaultFolder(10)
Set olConItems = olFolder.Items
        
'Número de fila donde comenzamos a traernos los datos importados
filaContacto = 2

'For each contact: if it is a business contact, write out the business info in the Excel worksheet;
'otherwise, write out the personal info.
For Each olItem In olConItems
    If TypeName(olItem) = "ContactItem" Then
        With olItem
                Cells(filaContacto, 1).Value = .CompanyName
                Cells(filaContacto, 2).Value = .FullName
                Cells(filaContacto, 3).Value = .Email1Address
                'otras propiedades de los contactos...:
                '.HomeAddressStreet '.HomeAddressPostalCode '.HomeAddressCity
                '.BusinessAddressCity '.BusinessAddressPostalCode '.BusinessAddressCity
        End With
        'aumentamos la fila
        filaContacto = filaContacto + 1
    End If
Next olItem

'Limpiamos las variables creadas.
Set olItem = Nothing
Set olConItems = Nothing
Set olFolder = Nothing
Set olNamespace = Nothing
Set olApp = Nothing
       
'mensaje de confirmación
MsgBox "Lista importada...!!", vbInformation
    
End Sub

Tras ejecutar veremos en nuestra 'Hoja1' de Libro de trabajo el listado de los contactos de Outlook: