Hoe exporteert u contactgegevens, inclusief foto’s, uit Outlook?

Wanneer u contacten uit Outlook naar een bestand exporteert, wordt alleen de tekstuele informatie meegenomen. Maar wat als u ook de profielfoto’s samen met de contactgegevens wilt exporteren? Hoe voert u die taak in Outlook uit?

Exporteer contactgegevens met bijbehorende foto’s met behulp van VBA-code

---

Exporteer contactgegevens met bijbehorende foto’s met behulp van VBA-code

De onderstaande VBA-code helpt u om alle contacten in een specifieke contactmap te exporteren naar afzonderlijke tekstbestanden, inclusief foto’s. Volg deze stappen:

1. Selecteer een contactmap waarvan u de contacten, inclusief hun foto’s, wilt exporteren.

2. Druk daarna op "ALT" + "F11" om het venster Microsoft Visual Basic for Applications te openen.

3. Klik vervolgens op "Invoegen" > „Module", kopieer de onderstaande code en plak deze in de lege module die nu is geopend – zie schermafbeelding:

VBA-code: exporteer contactgegevens met foto’s

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. Nadat u de code in de module hebt geplakt, klikt u in het venster "Microsoft Visual Basic for Applications" op "Extra" > „Verwijzingen". Schakel in het venster „Verwijzingen – Project1" dat verschijnt het selectievakje „Microsoft Scripting Runtime" in onder „Beschikbare verwijzingen", zie schermafbeelding:

5. Klik op 'OK' om het dialoogvenster te sluiten en druk vervolgens op de toets F5 om de code uit te voeren. Geef in het venster 'Bladeren naar map' dat verschijnt de map op waarin u de geëxporteerde contacten wilt opslaan (zie schermafbeelding).

6. Klik vervolgens op 'OK'. Alle gegevens, inclusief de foto’s van uw contacten, zijn nu afzonderlijk geëxporteerd naar de door u opgegeven map – zie schermafbeelding: