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

Author: Xiaoyang Last Modified: 2025-08-06

Cuando exporta contactos desde Outlook a un archivo, solo se puede exportar la información de texto de los contactos. Sin embargo, a veces, también necesita exportar las fotos junto con la información de texto de los contactos. ¿Cómo podría manejar esta tarea en Outlook?

Exportar información de contactos con fotos relacionadas utilizando código VBA

Exportar información de contactos con fotos relacionadas utilizando código VBA

El siguiente código VBA puede ayudarlo a exportar todos los contactos en una carpeta de contactos específica a archivos de texto separados con fotos. Por favor, siga estos pasos:

1. Seleccione una carpeta de contactos que desee exportar junto con las fotos.

2. Luego, mantenga presionadas las teclas "ALT" + "F11" para abrir la ventana "Microsoft Visual Basic para Aplicaciones".

3. Luego, haga clic en "Insertar" > "Módulo", copie y pegue el siguiente código en el módulo en blanco abierto, vea la captura de pantalla:

Código VBA: exportar información de contactos con 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. Después de pegar el código en el módulo, continúe haciendo clic en "Herramientas" > "Referencias" en la ventana "Microsoft Visual Basic para Aplicaciones", en el cuadro de diálogo emergente "Referencias-Proyecto1", marque la opción "Microsoft Scripting Runtime" de la lista de "Referencias Disponibles", vea la captura de pantalla:

5. Haga clic en "Aceptar" para cerrar el cuadro de diálogo, y luego presione la tecla "F5" para ejecutar este código, en el cuadro de diálogo emergente "Buscar Carpeta", especifique una carpeta donde desea guardar los contactos exportados, vea la captura de pantalla:

6. Luego haga clic en "Aceptar", toda la información junto con las fotos de los contactos ha sido exportada a su carpeta específica por separado, vea la captura de pantalla: