Necesito poder extraer desde Excel VBA la lista global de direcciones de Outlook.

No consigo información.

¿Alguien puede darme una pista?

Juan Luis.

mira si te sirve algo de lo comentado en esta añeja conversación

saludos,

hector.

Macro adaptada de la  Página de Ron de Bruin. (creo)

No te olvides de añadir la referencia Microsoft Outlook Library xx.x

 

Sub ImportarContactosOutlook(): On Error Resume Next

Application.ScreenUpdating = False

Dim olApp As Object 'Outlook.Application
Dim olContacts As Object 'Outlook.MAPIFolder
Dim olContact As Object 'Outlook.ContactItem
Dim i As Integer

Set olApp = New Outlook.Application
Set olContacts = olApp.GetNamespace("MAPI").GetDefaultFolder(olFolderContacts)
Cells.Clear

'importar contactos
For i = 1 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")
Rows(1).Insert

'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)"

End Sub

 

Editado el el 2 de abril9 años por Macro Antonio
Falta de ortografía

Uau!!! Sorprendente.

Hasta el lunes no puedo hacer la prueba.

Comentaré. Muchas gracias,

Juan.