Come esportare i contatti da Outlook insieme alle loro foto?

Quando si esportano i contatti da Outlook in un file, vengono salvate soltanto le informazioni testuali. Tuttavia, in alcuni casi è necessario esportare anche le foto associate ai contatti: come si può eseguire questa operazione in Outlook?

Esporta le informazioni dei contatti con le relative foto utilizzando codice VBA

---

Esporta le informazioni dei contatti con le relative foto utilizzando codice VBA

Il seguente codice VBA consente di esportare tutti i contatti presenti in una specifica cartella Contatti in singoli file di testo, inclusi i relativi allegati fotografici. Procedere come segue:

1. Seleziona la cartella contatti da cui desideri esportare i contatti con le foto.

2. Successivamente, tenere premuti i tasti «ALT» + "F11" per aprire la finestra di Microsoft Visual Basic, Applications.

3. Fare quindi clic su «Inserisci» > «Modulo», copiare e incollare il codice seguente nel modulo vuoto appena aperto, come illustrato nello screenshot:

Codice VBA: esporta le informazioni dei contatti con le foto

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. Dopo aver incollato il codice nel modulo, fai clic su «Strumenti» > «Riferimenti» nella finestra di «Microsoft Visual Basic, Applications»; nella finestra di dialogo "Riferimenti - Progetto1" che appare, seleziona l'opzione «Microsoft Scripting Runtime» dall'elenco «Riferimenti disponibili», come mostrato nello screenshot:

5. Fare clic su «OK» per chiudere la finestra di dialogo, quindi premere il tasto "F5" per eseguire il codice. Nella finestra di dialogo «Sfoglia cartelle» che viene visualizzata, specificare la cartella in cui si desidera salvare i contatti esportati, come mostrato nello screenshot:

6. Fare quindi clic su «OK»: tutte le informazioni, incluse le foto dei contatti, sono state esportate nella cartella specificata, come mostrato nello screenshot: