كيفية حفظ جميع المرفقات من رسائل البريد الإلكتروني المتعددة إلى مجلد في Outlook؟

من السهل حفظ جميع المرفقات من بريد إلكتروني واحد باستخدام ميزة "حفظ جميع المرفقات" المدمجة في Outlook. ومع ذلك، إذا كنت ترغب في حفظ جميع المرفقات من عدة رسائل بريد إلكتروني دفعة واحدة، فلا توجد ميزة مباشرة يمكن أن تساعدك. ستحتاج إلى تكرار استخدام ميزة "حفظ جميع المرفقات" لكل بريد إلكتروني حتى يتم حفظ جميع المرفقات من تلك الرسائل. هذا يستغرق وقتًا طويلاً. في هذه المقالة، نقدم طريقتين لمساعدتك على حفظ جميع المرفقات من رسائل متعددة بسهولة في مجلد معين في Outlook.

حفظ جميع المرفقات من رسائل البريد الإلكتروني المتعددة إلى مجلد باستخدام كود VBA
بضع نقرات لحفظ جميع المرفقات من رسائل البريد الإلكتروني المتعددة إلى مجلد باستخدام أداة رائعة

حفظ جميع المرفقات من رسائل البريد الإلكتروني المتعددة إلى مجلد باستخدام كود VBA

يوضح هذا القسم كود VBA خطوة بخطوة لمساعدتك على حفظ جميع المرفقات من رسائل البريد الإلكتروني المتعددة بسرعة في مجلد معين دفعة واحدة. يرجى اتباع الخطوات التالية:

1. أولاً، تحتاج إلى إنشاء مجلد لحفظ المرفقات على جهاز الكمبيوتر الخاص بك.

انتقل إلى مجلد "Documents" وأنشئ مجلدًا باسم "Attachments". انظر لقطة الشاشة:

2. حدد رسائل البريد الإلكتروني التي تحتوي على المرفقات التي تريد حفظها، ثم اضغط على مفتاحي "Alt" + "F11" لفتح نافذة "Microsoft Visual Basic for Applications".

3. انقر فوق "إدراج" > "وحدة" لفتح نافذة "الوحدة"، ثم قم بنسخ أحد أكواد VBA التالية في النافذة.

كود VBA 1: حفظ المرفقات بشكل جماعي من رسائل البريد الإلكتروني المتعددة (حفظ المرفقات بنفس الاسم مباشرة)

ملاحظة: سيقوم هذا الكود بحفظ المرفقات ذات الأسماء المتطابقة بإضافة الأرقام 1، 2، 3... بعد أسماء الملفات.

Dim GCount As Integer
Dim GFilepath As String
Public Sub SaveAttachments()
'Update 20200821
Dim xMailItem As Outlook.MailItem
Dim xAttachments As Outlook.Attachments
Dim xSelection As Outlook.Selection
Dim i As Long
Dim xAttCount As Long
Dim xFilePath As String, xFolderPath As String, xSaveFiles As String
On Error Resume Next
xFolderPath = CreateObject("WScript.Shell").SpecialFolders(16)
Set xSelection = Outlook.Application.ActiveExplorer.Selection
xFolderPath = xFolderPath & "\Attachments\"
If VBA.Dir(xFolderPath, vbDirectory) = vbNullString Then
    VBA.MkDir xFolderPath
End If
GFilepath = ""
For Each xMailItem In xSelection
    Set xAttachments = xMailItem.Attachments
    xAttCount = xAttachments.Count
    xSaveFiles = ""
    If xAttCount > 0 Then
        For i = xAttCount To 1 Step -1
            GCount = 0
            xFilePath = xFolderPath & xAttachments.Item(i).FileName
            GFilepath = xFilePath
            xFilePath = FileRename(xFilePath)
            If IsEmbeddedAttachment(xAttachments.Item(i)) = False Then
                xAttachments.Item(i).SaveAsFile xFilePath
                If xMailItem.BodyFormat <> olFormatHTML Then
                    xSaveFiles = xSaveFiles & vbCrLf & "<Error! Hyperlink reference not valid.>"
                Else
                    xSaveFiles = xSaveFiles & "<br>" & "<a href='file://" & xFilePath & "'>" & xFilePath & "</a>"
                End If
            End If
        Next i
    End If
Next
Set xAttachments = Nothing
Set xMailItem = Nothing
Set xSelection = Nothing
End Sub

Function FileRename(FilePath As String) As String
Dim xPath As String
Dim xFso As FileSystemObject
On Error Resume Next
Set xFso = CreateObject("Scripting.FileSystemObject")
xPath = FilePath
FileRename = xPath
If xFso.FileExists(xPath) Then
    GCount = GCount + 1
    xPath = xFso.GetParentFolderName(GFilepath) & "\" & xFso.GetBaseName(GFilepath) & " " & GCount & "." + xFso.GetExtensionName(GFilepath)
    FileRename = FileRename(xPath)
End If
xFso = Nothing
End Function

Function IsEmbeddedAttachment(Attach As Attachment)
Dim xItem As MailItem
Dim xCid As String
Dim xID As String
Dim xHtml As String
On Error Resume Next
IsEmbeddedAttachment = False
Set xItem = Attach.Parent
If xItem.BodyFormat <> olFormatHTML Then Exit Function
xCid = ""
xCid = Attach.PropertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x3712001F")
If xCid <> "" Then
    xHtml = xItem.HTMLBody
    xID = "cid:" & xCid
    If InStr(xHtml, xID) > 0 Then
        IsEmbeddedAttachment = True
    End If
End If
End Function

كود VBA 2: حفظ المرفقات بشكل جماعي من رسائل البريد الإلكتروني المتعددة (التحقق من التكرارات)

Public Sub SaveAttachments()
'Update 20200821
Dim xMailItem As Outlook.MailItem
Dim xAttachments As Outlook.Attachments
Dim xSelection As Outlook.Selection
Dim i As Long
Dim xAttCount As Long
Dim xFilePath As String, xFolderPath As String, xSaveFiles As String
Dim xYesNo As Integer
Dim xFlag As Boolean
On Error Resume Next
xFolderPath = CreateObject("WScript.Shell").SpecialFolders(16)
Set xSelection = Outlook.Application.ActiveExplorer.Selection
xFolderPath = xFolderPath & "\Attachments\"
If VBA.Dir(xFolderPath, vbDirectory) = vbNullString Then
    VBA.MkDir xFolderPath
End If
For Each xMailItem In xSelection
    Set xAttachments = xMailItem.Attachments
    xAttCount = xAttachments.Count
    xSaveFiles = ""
    If xAttCount > 0 Then
        For i = xAttCount To 1 Step -1
            xFilePath = xFolderPath & xAttachments.Item(i).FileName
            xFlag = True
            If VBA.Dir(xFilePath, 16) <> Empty Then
                xYesNo = MsgBox("The file is exists, do you want to replace it", vbYesNo + vbInformation, "Kutools for Outlook")
                If xYesNo = vbNo Then xFlag = False
            End If
            If xFlag = True Then
                xAttachments.Item(i).SaveAsFile xFilePath
                If xMailItem.BodyFormat <> olFormatHTML Then
                    xSaveFiles = xSaveFiles & vbCrLf & "<Error! Hyperlink reference not valid.>"
                Else
                    xSaveFiles = xSaveFiles & "<br>" & "<a href='file://" & xFilePath & "'>" & xFilePath & "</a>"
                End If
            End If
        Next i
    End If
Next
Set xAttachments = Nothing
Set xMailItem = Nothing
Set xSelection = Nothing
End Sub

ملاحظات:

1) إذا كنت ترغب في حفظ جميع المرفقات التي تحمل نفس الاسم في مجلد، يرجى تطبيق "كود VBA 1" أعلاه. قبل تشغيل هذا الكود، يرجى النقر فوق "أدوات" > "المراجع"، ثم وضع علامة اختيار بجانب خانة "Microsoft Scripting Runtime" في مربع الحوار "المراجع - المشروع".

2) إذا كنت ترغب في التحقق من أسماء المرفقات المكررة، يرجى تطبيق "كود VBA 2". بعد تشغيل الكود، ستظهر نافذة منبثقة لتذكيرك ما إذا كنت تريد استبدال المرفقات المكررة، اختر "نعم" أو "لا" بناءً على احتياجاتك.

5. اضغط على مفتاح "F5" لتشغيل الكود.

ثم يتم حفظ جميع المرفقات في الرسائل المحددة في المجلد الذي أنشأته في الخطوة 1.

ملاحظات: قد تظهر نافذة منبثقة من "Microsoft Outlook"، يرجى النقر فوق زر "السماح" للمتابعة.

حفظ جميع المرفقات من رسائل البريد الإلكتروني المتعددة إلى مجلد باستخدام أداة رائعة

إذا كنت جديدًا في VBA، هنا نوصي بشدة بأداة "حفظ جميع المرفقات" من "Kutools for Outlook" لك. باستخدام هذه الأداة، يمكنك بسرعة حفظ جميع المرفقات من رسائل البريد الإلكتروني المتعددة دفعة واحدة بنقرات قليلة فقط في Outlook.

1. حدد رسائل البريد الإلكتروني التي تحتوي على المرفقات التي تريد حفظها.

ملاحظة: يمكنك تحديد رسائل بريد إلكتروني متعددة وغير متجاورة عن طريق الضغط باستمرار على مفتاح "Ctrl" واختيارها واحدة تلو الأخرى؛
أو حدد رسائل بريد إلكتروني متعددة ومتجاورة عن طريق الضغط باستمرار على مفتاح "Shift" واختيار أول رسالة وآخر رسالة.

2. انقر فوق "Kutools Plus" > "أدوات المرفقات" > "حفظ الكل". انظر لقطة الشاشة:

3. في مربع حوار "إعدادات الحفظ"، انقر فوق الزر لتحديد مجلد لحفظ المرفقات، ثم انقر فوق زر "موافق".

4. انقر فوق "موافق" مرتين في مربعات الحوار المنبثقة التالية. ثم يتم حفظ جميع المرفقات في الرسائل المحددة في المجلد المحدد دفعة واحدة.

ملاحظات:

• 1. إذا كنت ترغب في حفظ المرفقات في مجلدات مختلفة بناءً على رسائل البريد الإلكتروني، يرجى وضع علامة اختيار بجانب خانة "إنشاء مجلدات فرعية بالأسلوب التالي" واختيار نمط المجلد من القائمة المنسدلة.
• 2. بالإضافة إلى حفظ جميع المرفقات، يمكنك حفظ المرفقات بناءً على شروط معينة. على سبيل المثال، إذا كنت ترغب فقط في حفظ مرفقات ملفات PDF التي يحتوي اسم الملف فيها على كلمة "Invoice"، يرجى النقر فوق زر "خيارات متقدمة" لتوسيع الشروط، ثم قم بالتكوين كما هو موضح أدناه.
  
• 3. إذا كنت ترغب في حفظ المرفقات تلقائيًا عند وصول رسائل البريد الإلكتروني، يمكن لميزة حفظ المرفقات تلقائيًا المساعدة.
• 4. لفصل المرفقات مباشرة من الرسائل المحددة، يمكن لميزة فصل جميع المرفقات في "Kutools for Outlook" مساعدتك.

مقالات ذات صلة

---

أفضل أدوات تعزيز الإنتاجية في المكتب

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

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

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

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

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

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

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

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

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

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

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

جدول أحادي الأبعاد لميزات Kutools لـ Outlook تنزيل الآن انتقل للشراء

🚀 تنزيل بنقرة واحدة — احصل على جميع إضافات Office

موصى به بقوة: Kutools لـ Office (خمسة في واحد)

بنقرة واحدة يمكنك تنزيل خمسة برامج تثبيت مرة واحدة — Kutools لـ Excel وOutlook وWord وPowerPoint وOffice Tab Pro. انقر لتنزيل الآن!

• ✅ سهولة بنقرة واحدة: قم بتنزيل جميع حزم التثبيت الخمسة دفعة واحدة.
• 🚀 جاهز لأي مهمة في Office: ثبّت الإضافات التي تحتاجها وقتما تشاء.
• 🧰 يتضمن: Kutools لـ Excel / Kutools لـ Outlook / Kutools لـ Word / Office Tab Pro / Kutools لـ PowerPoint

حول الحزمة ⬇ تنزيل الحزمة 💳 شراء الحزمة