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

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

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

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

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

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

انتقِل إلى مجلد «Documents» وأنشئ فيه مجلدًا باسم «Attachments». راجع لقطة الشاشة التالية:

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

3. انقر على «Insert» > «Module» لفتح نافذة «Module»، ثم الصق أحد أكواد 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» أعلاه. قبل تشغيل هذا الرمز، يُرجى النقر على «Tools» > «References»، ثم تحديد خانة «Microsoft Scripting Runtime» في مربع حوار «References - Project».

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

5. اضغط مفتاح "F5" لتشغيل الرمز.

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

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

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

إذا كنت مبتدئًا في استخدام VBA، فننصحك بشدة باعتماد أداة «Save All Attachments» من «Kutools لـ Outlook»، التي تتيح لك حفظ جميع المرفقات من رسائل متعددة دفعة واحدة بنقرات قليلة فقط داخل Outlook.

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

نصائح: يمكنك تحديد عدة رسائل غير متجاورة بالضغط باستمرار على مفتاح «Ctrl» وتحديد كل رسالة على حدة؛
أو تحديد مجموعة من الرسائل المتجاورة بالضغط باستمرار على مفتاح «Shift»، ثم النقر على أول رسالة وأخيرًا على آخر رسالة.

2. انقر على «KUTOOLS PLUS» > «أدوات المرفقات» > «حفظ الكل». انظر لقطة الشاشة:

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

4. انقر على «موافق» مرتين في مربعي الحوار المنبثقين التاليين، ليتم بعد ذلك حفظ جميع المرفقات من الرسائل المحددة دفعةً واحدة في المجلد الذي حددته.

ملاحظات:

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

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

---

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

جرِّب Kutools لـ Outlook الجديد كليًّا مع 100+ ميزة رائعة!انقر للتنزيل الآن!

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

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

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

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

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

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

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

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

افتح Kutools لـ Outlook بنقرة واحدة فورًا! لا تنتظر، نزِّله الآن وحسِّن كفاءتك!

قائمة ميزات Kutools لـ Outlook      نزِّل الآن      اذهب للشراء

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

موصى به بشدة: Kutools for Office (5 في 1)

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

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

حول الحزمة⬇ نزِّل الحزمة💳 اشترِ الحزمة