Skip to main content

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

Author: Xiaoyang Last Modified: 2025-05-30

عند تصدير جهات الاتصال من 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

أفضل أدوات الإنتاجية لمجموعة Office

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

جرّب الآن الإصدار المجاني الجديد كليًا من أدوات Kutools لـ Outlook مع أكثر من70 ميزة مذهلة، متاحة لك مدى الحياة! انقر للتحميل الآن!

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

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

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

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

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

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

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

افتح أدوات Kutools لـ Outlook فورًا بنقرة واحدة. لا تنتظر، قم بالتحميل الآن وزد من إنتاجيتك!

kutools for outlook features1 kutools for outlook features2