Como exportar as informações dos contactos, incluindo as respetivas fotografias, no Outlook?

Quando exporta contactos do Outlook para um ficheiro, apenas a informação textual é incluída. No entanto, por vezes precisa de que as fotografias sejam também exportadas juntamente com os dados dos contactos. Como pode realizar esta tarefa no Outlook?

Exportar as informações dos contactos com as respetivas fotografias utilizando código VBA

---

Exportar as informações dos contactos com as respetivas fotografias utilizando código VBA

O código VBA abaixo permite-lhe exportar todos os contactos de uma pasta específica para ficheiros de texto individuais, incluindo as respetivas fotografias. Siga os passos seguintes:

1. Selecione a pasta de contactos da qual deseja exportar os contactos, incluindo as respetivas fotografias.

2. Em seguida, prima simultaneamente as teclas «ALT» + "F11" para abrir a janela do Microsoft Visual Basic for Applications.

3. Depois, clique em «Inserir» > «Módulo», copie e cole o código abaixo no módulo em branco que se abre, conforme ilustrado na imagem:

Código VBA: exportar as informações dos contactos com fotografias

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, clique em «Ferramentas» > «Referências» na janela do Microsoft Visual Basic for Applications. Na caixa de diálogo «Referências – Projeto1» que aparece, ative a opção «Microsoft Scripting Runtime» na lista «Referências disponíveis», conforme ilustrado na imagem:

5. Clique em «OK» para fechar a caixa de diálogo e, de seguida, prima a tecla "F5" para executar o código. Na caixa de diálogo «Procurar Pasta» que aparece, indique a pasta onde pretende guardar os contactos exportados, conforme ilustrado na imagem:

6. Em seguida, clique em «OK». Todas as informações, incluindo as fotografias dos contactos, foram exportadas separadamente para a pasta especificada, conforme ilustrado na imagem: