¿Cómo exportar la información de los contactos junto con sus fotos desde Outlook?

Al exportar contactos desde Outlook a un archivo, solo se guarda la información textual de los contactos. No obstante, en ocasiones también necesita incluir las fotos junto con dicha información. ¿Cómo puede lograrlo en Outlook?

Exporte la información de los contactos con sus fotos correspondientes mediante código VBA

---

Exporte la información de los contactos con sus fotos correspondientes mediante código VBA

El siguiente código VBA le permite exportar todos los contactos de una carpeta de contactos específica a archivos de texto independientes, incluyendo sus fotos. Siga estos pasos:

1. Seleccione la carpeta de contactos de la que desea exportar los contactos junto con sus fotos.

2. A continuación, mantenga pulsadas las teclas «ALT» + «F11» para abrir la ventana de Microsoft Visual Basic para Aplicaciones.

3. A continuación, haga clic en «Insertar» > «Módulo», copie y pegue el siguiente código en el módulo en blanco que se abre; consulte la captura de pantalla:

Código VBA: exporte la información de los contactos con sus fotos

Sub BatchExportContactPhotosandInformation()
Dim xContactItems As Outlook.Items
Dim xItem As Object
Dim xContactItem As ContactItem
Dim xContactInfo As String
Dim xShell As Object
Dim xFSO As Scripting.FileSystemObject
Dim xTextFile As Scripting.TextStream
Dim xAttachments As Attachments
Dim xAttachment As Attachment
Dim xSavePath, xEmailAddress As String
Dim xFolder As Outlook.Folder
On Error Resume Next
Set xFSO = CreateObject("Scripting.FileSystemObject")
Set xShell = CreateObject("Shell.application").BrowseforFolder(0, "Select a Folder", 0, 16)
If xShell Is Nothing Then Exit Sub
xSavePath = xShell.Items.Item.Path & "\"
If Outlook.Application.ActiveExplorer.CurrentFolder.DefaultItemType <> olContactItem Then
    Set xFolder = Outlook.Application.Session.GetDefaultFolder(olFolderContacts)
Else
    Set xFolder = Outlook.Application.ActiveExplorer.CurrentFolder
End If
Set xContactItems = xFolder.Items
For i = xContactItems.Count To 1 Step -1
    Set xItem = xContactItems.Item(i)
    If xItem.Class = olContact Then
        Set xContactItem = xItem
        With xContactItem
            xEmailAddress = .Email1Address
            If Len(Trim(.Email2Address)) <> 0 Then
                xEmailAddress = xEmailAddress & ";" & .Email2Address
            End If
            If Len(Trim(.Email3Address)) <> 0 Then
                xEmailAddress = xEmailAddress & ";" & .Email3Address
            End If
            xContactInfo = "Name: " & .FullName & vbCrLf & "Email: " & _
                           xEmailAddress & vbCrLf & "Company: " & .CompanyName & _
                           vbCrLf & "Department: " & .Department & _
                           vbCrLf & "Job Title: " & .JobTitle & _
                           vbCrLf & "IM: " & .IMAddress & _
                           vbCrLf & "Business Phone: " & .BusinessTelephoneNumber & _
                           vbCrLf & "Home Phone: " & .HomeTelephoneNumber & _
                           vbCrLf & "BusinessFax Phone: " & .BusinessFaxNumber & _
                           vbCrLf & "Mobile Phone: " & .MobileTelephoneNumber & _
                           vbCrLf & "Business Address: " & .BusinessAddress
            Set xTextFile = xFSO.CreateTextFile(xSavePath & .FullName & ".txt", True)
            xTextFile.WriteLine xContactInfo
            If .Attachments.Count > 0 Then
                Set xAttachments = .Attachments
                For Each xAttachment In xAttachments
                    If InStr(LCase(xAttachment.FileName), "contactpicture.jpg") > 0 Then
                        xAttachment.SaveAsFile (xSavePath & .FullName & ".jpg")
                    End If
                Next
            End If
        End With
    End If
Next i
End Sub

4. Tras pegar el código en el módulo, vaya a «Herramientas» > «Referencias» en la ventana de «Microsoft Visual Basic para Aplicaciones». En el cuadro de diálogo emergente «Referencias - Proyecto1», active la opción «Microsoft Scripting Runtime» en la lista «Referencias disponibles»; consulte la captura de pantalla:

5. Haga clic en «Aceptar» para cerrar el cuadro de diálogo y, a continuación, pulse la tecla «F5» para ejecutar este código. En el cuadro de diálogo emergente «Examinar carpeta», especifique la carpeta donde desea guardar los contactos exportados; consulte la captura de pantalla:

6. A continuación, haga clic en «Aceptar». Toda la información, incluidas las fotos de los contactos, se ha exportado por separado a la carpeta especificada; consulte la captura de pantalla: