Kişilerin bilgilerini Outlook'taki fotoğraflarla nasıl dışa aktarabilirim?
Kişileri Outlook'tan bir dosyaya aktardığınızda, yalnızca kişilerin metin bilgileri dışa aktarılabilir. Ancak bazen, kişilerin metin bilgilerinin yanı sıra dışa aktarılacak fotoğraflara da ihtiyaç duyarsınız, Outlook'ta bu görevi nasıl halledebilirsiniz?
VBA kodunu kullanarak kişi bilgilerini ilgili fotoğraflarla dışa aktarın
VBA kodunu kullanarak kişi bilgilerini ilgili fotoğraflarla dışa aktarın
Aşağıdaki VBA kodu, belirli bir kişi klasöründeki tüm kişileri fotoğraflarla metin dosyasını ayırmak için dışa aktarmanıza yardımcı olabilir. Lütfen şunu yapın:
1. Kişileri fotoğraflarla dışa aktarmak istediğiniz bir kişi klasörünü seçin.
2. Ve sonra, basılı tutun ALT + F11 tuşlarını açmak için Uygulamalar için Microsoft Visual Basic pencere.
3. Daha sonra, Ekle > modül, aşağıdaki kodu kopyalayıp açılan boş modüle yapıştırın, ekran görüntüsüne bakın:
VBA kodu: kişilerin bilgilerini fotoğraflarla dışa aktarın:
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, Tools > Referanslar içinde Uygulamalar için Microsoft Visual Basic pencere, dışarı çıkmış Referanslar-Proje1 iletişim kutusu, işaretleyin Microsoft Komut Dosyası Çalışma Zamanı seçeneği Mevcut Referanslar liste kutusu, ekran görüntüsüne bakın:
5. tıklayın OK iletişim kutusunu kapatmak için ve ardından F5 bu kodu çalıştırmanın anahtarı, Klasöre Göz At iletişim kutusu, dışa aktarılan kişilerin çıktısını almak istediğiniz bir klasör belirtin, ekran görüntüsüne bakın:
6. Sonra tıklayın OK, kişilerin fotoğraflarıyla birlikte tüm bilgiler özel klasörünüze ayrı ayrı aktarılmıştır, ekran görüntüsüne bakın:
En İyi Ofis Üretkenlik Araçları
Outlook için Kutools - Outlook'unuzu Güçlendirecek 100'den Fazla Güçlü Özellik
🤖 AI Posta Yardımcısı: Yapay zeka büyüsüyle anında profesyonel e-postalar: tek tıkla dahice yanıtlar, mükemmel ton, çok dilli ustalık. E-posta göndermeyi zahmetsizce dönüştürün! ...
???? E-posta Otomasyonu: Ofis Dışında (POP ve IMAP için kullanılabilir) / E-posta Gönderimini Planla / E-posta Gönderirken Kurallara Göre Otomatik CC/BCC / Otomatik İletme (Gelişmiş Kurallar) / Otomatik Karşılama Ekleme / Çok Alıcılı E-postaları Otomatik Olarak Bireysel Mesajlara Bölün ...
📨 E-posta Yönetimi: E-postaları Kolayca Geri Çağırın / Dolandırıcılık E-postalarını Konulara ve Diğerlerine Göre Engelleyin / Yinelenen E-postaları Silin / gelişmiş Arama / Klasörleri Birleştir ...
📁 Ekler Pro: Toplu Kaydetme / Toplu Ayır / Toplu Sıkıştırma / Otomatik kaydet / Otomatik Ayır / Otomatik Sıkıştır ...
🌟 Arayüz Büyüsü: 😊Daha Fazla Güzel ve Havalı Emoji / Sekmeli Görünümlerle Outlook Verimliliğinizi Artırın / Outlook'u Kapatmak Yerine Küçültün ...
👍 Tek Tıklamayla Harikalar: Tümünü Gelen Eklerle Yanıtla / Kimlik Avına Karşı E-postalar / 🕘Gönderenin Saat Dilimini Göster ...
👩🏼🤝👩🏻 Kişiler ve Takvim: Seçilen E-postalardan Toplu Kişi Ekleme / Kişi Grubunu Bireysel Gruplara Bölme / Doğum Günü Hatırlatıcılarını Kaldır ...
üzerinde 100 Özellikler Keşfinizi Bekleyin! Daha Fazlasını Keşfetmek İçin Buraya Tıklayın.
