Como exportar informações de contatos junto com fotos no Outlook?

Author: Xiaoyang Last Modified: 2025-08-06

Ao exportar contatos do Outlook para um arquivo, apenas as informações de texto dos contatos podem ser exportadas. No entanto, às vezes, você também precisa que as fotos sejam exportadas juntamente com as informações de texto dos contatos. Como você pode lidar com essa tarefa no Outlook?

Exportar informações de contatos com fotos relacionadas usando código VBA

Exportar informações de contatos com fotos relacionadas usando código VBA

O código VBA abaixo pode ajudá-lo a exportar todos os contatos em uma pasta de contatos específica para arquivos de texto separados com fotos. Por favor, siga estas instruções:

1. Selecione uma pasta de contatos da qual deseja exportar os contatos com fotos.

2. Em seguida, pressione e segure as teclas "ALT" + "F11" para abrir a janela "Microsoft Visual Basic for Applications".

3. Depois disso, clique em "Inserir" > "Módulo", copie e cole o código abaixo no módulo em branco aberto, veja a captura de tela:

Código VBA: exportar informações de contatos com 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. Após colar o código no módulo, continue clicando em "Ferramentas" > "Referências" na janela "Microsoft Visual Basic for Applications", na caixa de diálogo "Referências-Projeto1" que apareceu, marque a opção "Microsoft Scripting Runtime" na lista de "Referências Disponíveis", veja a captura de tela:

5. Clique em "OK" para fechar a caixa de diálogo e depois pressione a tecla "F5" para executar este código. Na caixa de diálogo "Procurar Pasta" que apareceu, especifique uma pasta onde deseja salvar os contatos exportados, veja a captura de tela:

6. Em seguida, clique em "OK", todas as informações com as fotos dos contatos foram exportadas para sua pasta específica separadamente, veja a captura de tela: