Excel. Importar contactos de Outlook

Ver el tema anterior Ver el tema siguiente Ir abajo

Excel. Importar contactos de Outlook

Mensaje por gbp el Dom 7 Feb 2010 - 0:03

Muchas veces una vez añadidos los datos de telefono, dirección etc., de nuestros familiares y amigos a contactos de Outlook creemos que ya los tenemos para siempre.
Con este codigo podrás disponer de los datos de contactos de Outlook además en un fichero de Excel como copia de seguridad o para usarlos en otras aplicaciones.

Copiar y pegar el siguiente codigo en un modulo VBA de Excel, y luego ejecutarlo.

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





Ayuda para navegar por el foro

LIVE AS IF YOU WERE TO DIE TOMORROW. LEARN AS IF YOU WERE TO LIVE FOREVER. - MOHANDAS GANDHI
Invitado -- "Interesante...:

Ver tu historial de navegación Google.
Ver la información de tus cuentas Google y mas..
Extraer el sonido de un video a mp3
Editor de imagenes online


gbp
..
..

Fecha de inscripción : 08/09/2009

Volver arriba Ir abajo

Re: Excel. Importar contactos de Outlook

Mensaje por Nassy el Dom 7 Feb 2010 - 0:31

Yo es que no uso de eso, aunque gracias por la informacion

Nassy
Usuario Vip
Usuario Vip

Fecha de inscripción : 01/01/2010

Volver arriba Ir abajo

Re: Excel. Importar contactos de Outlook

Mensaje por Yunke el Lun 4 Ago 2014 - 8:19

gbp escribió:Muchas veces una vez añadidos los datos de telefono, dirección etc., de nuestros familiares y amigos a contactos de Outlook creemos que ya los tenemos para siempre.
Con este codigo podrás disponer de los datos de contactos de Outlook además en un fichero de Excel como copia de seguridad o para usarlos en otras aplicaciones.

Copiar y pegar el siguiente codigo en un modulo VBA de Excel, y luego ejecutarlo.

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


 ok1  ok1  ok1  ok1  ok1  ok1  ok1

Yunke
Super Usuario
Super Usuario

Fecha de inscripción : 22/12/2013

Volver arriba Ir abajo

Re: Excel. Importar contactos de Outlook

Mensaje por Contenido patrocinado Hoy a las 18:57


Contenido patrocinado


Volver arriba Ir abajo

Ver el tema anterior Ver el tema siguiente Volver arriba


 
Permisos de este foro:
No puedes responder a temas en este foro.