Skip to main content

كيفية تصدير معلومات جهات الاتصال مع الصور في Outlook؟

Author: Xiaoyang Last Modified: 2025-08-06

عند تصدير جهات الاتصال من 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
doc export contacts with photos 1

4. بعد لصق الكود في الوحدة، استمر بالنقر فوق "أدوات" > "المراجع" في نافذة "Microsoft Visual Basic for Applications"، وفي مربع الحوار المنبثق "References-Project1"، قم بتحديد خيار "Microsoft Scripting Runtime" من قائمة المراجع المتاحة، انظر إلى لقطة الشاشة:

doc export contacts with photos 2

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

doc export contacts with photos 3

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

doc export contacts with photos 4

أفضل أدوات إنتاجية أوفيس

أخبار عاجلة: أدوات Kutools لـ Outlook تطلق إصدارًا مجانيًا!

اختبر أدوات Kutools لـ Outlook الجديدة كليًا مع أكثر من100 ميزة مذهلة! انقر لتحميلها الآن!

🤖 Kutools AI : يستخدم تقنية الذكاء الاصطناعي المتقدمة لإدارة البريد الإلكتروني بسهولة، بما في ذلك الرد، التلخيص، التحسين، التوسيع، الترجمة، وإنشاء الرسائل.

📧 أتمتة البريد الإلكتروني: الرد التلقائي (متاح لـ POP و IMAP) / جدولة إرسال البريد / نسخة تلقائية/مخفية عن طريق القواعد عند إرسال البريد / التحويل التلقائي (قاعدة متقدمة) / إضافة التحية تلقائيًا / تقسيم رسائل البريد الإلكتروني متعددة المستلمين تلقائيًا إلى رسائل منفصلة...

📨 إدارة البريد الإلكتروني: استدعاء البريد الإلكتروني / حظر رسائل الاحتيال حسب الموضوع وغيرها / حذف الرسائل المكررة / البحث المتقدم / تنظيم المجلدات...

📁 المرفقات المتقدمة: حفظ دفعة واحدة / فصل دفعة واحدة / ضغط دفعة واحدة / حفظ تلقائي / تفصيل تلقائي / ضغط تلقائي...

🌟 سحر الواجهة: 😊 المزيد من الرموز التعبيرية الجميلة والمميزة / تذكير عند وصول البريد الهام / تصغير Outlook بدل الإغلاق...

👍 ميزات بضغطة واحدة: الرد على الجميع مع المرفقات / الحماية من التصيد الاحتيالي / 🕘 عرض المنطقة الزمنية للمرسل...

👩🏼‍🤝‍👩🏻 جهات الاتصال والتقويم: إضافة جهات الاتصال دفعة واحدة من الرسائل المحددة / تقسيم مجموعة جهات الاتصال إلى مجموعات فردية / إزالة تذكير عيد الميلاد...

استخدم أدوات Kutools بلغتك المفضلة – يدعم الإنجليزية، الإسبانية، الألمانية، الفرنسية، الصينية، وأكثر من40 لغة أخرى!

افتح أدوات Kutools لـ Outlook فوراً بنقرة واحدة. لا تنتظر، حمِّله الآن وحقق كفاءة أعلى!

kutools for outlook features1 kutools for outlook features2