Outlook’ta kişilerin bilgilerini fotoğraflarıyla birlikte nasıl dışa aktarabilirsiniz?

Outlook’tan kişileri bir dosyaya dışa aktardığınızda yalnızca metin bilgileri aktarılabilir. Peki, kişi fotoğraflarını da dışa aktarmak gerektiğinde bu işlemi Outlook’ta nasıl yapabilirsiniz?

Kişilerin bilgilerini ilgili fotoğraflarıyla birlikte VBA kodu kullanarak dışa aktarma

---

Kişilerin bilgilerini ilgili fotoğraflarıyla birlikte VBA kodu kullanarak dışa aktarma

Aşağıdaki VBA kodu, belirli bir kişi klasöründeki tüm kişileri fotoğraflarıyla birlikte ayrı metin dosyaları olarak dışa aktarmanıza yardımcı olur. Lütfen aşağıdaki adımları izleyin:

1. Fotoğraflarıyla birlikte dışa aktarmak istediğiniz kişi klasörünü seçin.

2. Ardından "Microsoft Visual Basic for Applications" penceresini açmak için "ALT" + "F11" tuşlarına basın.

3. Ardından "Ekle" > "Modül" seçeneğine tıklayıp açılan boş modüle aşağıdaki kodu kopyalayıp yapıştırın; ekran görüntüsüne göz atın:

VBA kodu: Kişilerin bilgilerini fotoğraflarıyla birlikte dışa aktarma

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. Kodu modüle yapıştırdıktan sonra, "Microsoft Visual Basic for Applications" penceresinde "Araçlar" > "Referanslar" seçeneğine tıklayın. Açılan "Referanslar – Proje1" iletişim kutusunda, "Kullanılabilir Referanslar" listesinden "Microsoft Scripting Runtime" öğesini işaretleyin; ekran görüntüsüne bakın:

5. İletişim kutusunu kapatmak için "Tamam" düğmesine tıklayın, ardından bu kodu çalıştırmak için "F5" tuşuna basın. Açılan "Klasör Seç" iletişim kutusunda dışa aktarılan kişilerin çıktısını almak istediğiniz klasörü belirtin; ekran görüntüsüne bakın:

6. Ardından "Tamam" düğmesine tıklayın; kişilerin tüm bilgileri ve fotoğrafları belirttiğiniz klasöre ayrı ayrı dışa aktarılacaktır. Ekran görüntüsüne bakın: