كيفية تصدير معلومات جهات الاتصال مع الصور في Outlook؟
عند تصدير جهات الاتصال من Outlook إلى ملف، يمكن تصدير المعلومات النصية فقط. لكن في بعض الأحيان، قد تحتاج إلى تصدير الصور أيضًا مع معلومات جهات الاتصال النصية، فكيف يمكنك التعامل مع هذه المهمة في Outlook؟
تصدير معلومات جهات الاتصال مع الصور ذات الصلة باستخدام كود VBA
تصدير معلومات جهات الاتصال مع الصور ذات الصلة باستخدام كود VBA
الكود التالي لـ VBA يمكن أن يساعدك على تصدير جميع جهات الاتصال الموجودة في مجلد جهة اتصال محدد إلى ملف نصي منفصل مع الصور. الرجاء القيام بما يلي:
1. حدد مجلد جهة اتصال الذي تريد تصدير جهات الاتصال منه مع الصور.
2. ثم اضغط مع الاستمرار على مفتاحي "ALT" + "F11" لفتح نافذة "Microsoft Visual Basic for Applications".
3. بعد ذلك، انقر فوق "إدراج" > "وحدة"، وقم بنسخ ولصق الكود أدناه في الوحدة الفارغة التي تم فتحها، انظر إلى لقطة الشاشة:
كود VBA: تصدير معلومات جهات الاتصال مع الصور
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. بعد لصق الكود في الوحدة، استمر بالنقر فوق "أدوات" > "المراجع" في نافذة "Microsoft Visual Basic for Applications"، وفي مربع الحوار المنبثق "References-Project1"، قم بتحديد خيار "Microsoft Scripting Runtime" من قائمة المراجع المتاحة، انظر إلى لقطة الشاشة:

5. انقر فوق "موافق" لإغلاق مربع الحوار، ثم اضغط على مفتاح "F5" لتشغيل هذا الكود، وفي مربع الحوار المنبثق "Browse For Folder"، حدد المجلد الذي تريد إخراج جهات الاتصال المصدرة إليه، انظر إلى لقطة الشاشة:

6. ثم انقر فوق "موافق"، سيتم تصدير جميع المعلومات مع صور جهات الاتصال إلى المجلد المحدد بشكل منفصل، انظر إلى لقطة الشاشة:

أفضل أدوات إنتاجية أوفيس
أخبار عاجلة: أدوات Kutools لـ Outlook تطلق إصدارًا مجانيًا!
اختبر أدوات Kutools لـ Outlook الجديدة كليًا مع أكثر من100 ميزة مذهلة! انقر لتحميلها الآن!
📧 أتمتة البريد الإلكتروني: الرد التلقائي (متاح لـ POP و IMAP) / جدولة إرسال البريد / نسخة تلقائية/مخفية عن طريق القواعد عند إرسال البريد / التحويل التلقائي (قاعدة متقدمة) / إضافة التحية تلقائيًا / تقسيم رسائل البريد الإلكتروني متعددة المستلمين تلقائيًا إلى رسائل منفصلة...
📨 إدارة البريد الإلكتروني: استدعاء البريد الإلكتروني / حظر رسائل الاحتيال حسب الموضوع وغيرها / حذف الرسائل المكررة / البحث المتقدم / تنظيم المجلدات...
📁 المرفقات المتقدمة: حفظ دفعة واحدة / فصل دفعة واحدة / ضغط دفعة واحدة / حفظ تلقائي / تفصيل تلقائي / ضغط تلقائي...
🌟 سحر الواجهة: 😊 المزيد من الرموز التعبيرية الجميلة والمميزة / تذكير عند وصول البريد الهام / تصغير Outlook بدل الإغلاق...
👍 ميزات بضغطة واحدة: الرد على الجميع مع المرفقات / الحماية من التصيد الاحتيالي / 🕘 عرض المنطقة الزمنية للمرسل...
👩🏼🤝👩🏻 جهات الاتصال والتقويم: إضافة جهات الاتصال دفعة واحدة من الرسائل المحددة / تقسيم مجموعة جهات الاتصال إلى مجموعات فردية / إزالة تذكير عيد الميلاد...
استخدم أدوات Kutools بلغتك المفضلة – يدعم الإنجليزية، الإسبانية، الألمانية، الفرنسية، الصينية، وأكثر من40 لغة أخرى!
افتح أدوات Kutools لـ Outlook فوراً بنقرة واحدة. لا تنتظر، حمِّله الآن وحقق كفاءة أعلى!

