كيفية إرسال عدة مسودات دفعة واحدة في Outlook؟

Author: Xiaoyang Last Modified: 2025-08-06

إذا كان لديك عدة رسائل مسودة في مجلد المسودات، وترغب الآن في إرسالها جميعًا دفعة واحدة دون الحاجة إلى إرسالها واحدة تلو الأخرى. كيف يمكنك التعامل مع هذه المهمة بسرعة وسهولة في Outlook؟

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

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

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

1. اضغط باستمرار على مفتاحي ALT + F11 لفتح نافذة Microsoft Visual Basic for Applications.

2. ثم انقر فوق إدراج > وحدة، قم بنسخ والصق الكود أدناه في الوحدة الفارغة المفتوحة، انظر الصورة:

كود VBA: إرسال جميع رسائل المسودات دفعة واحدة في Outlook:

Sub SendAllDraftEmails()
Dim xAccount As Account
Dim xDraftFld As Folder
Dim xItemCount As Integer
Dim xCount As Integer
Dim xDraftsItems As Outlook.Items
Dim xPromptStr As String
Dim xYesOrNo As Integer
Dim i As Long
Dim xCurFld As Folder
Dim xTmpFld As Folder
On Error Resume Next
xItemCount = 0
xCount = 0
Set xTmpFld = Nothing
Set xCurFld = Application.ActiveExplorer.CurrentFolder
For Each xAccount In Outlook.Application.Session.Accounts
    Set xDraftFld = xAccount.DeliveryStore.GetDefaultFolder(olFolderDrafts)
    xItemCount = xItemCount + xDraftFld.Items.Count
    If xDraftFld.EntryID = xCurFld.EntryID Then
        Set xTmpFld = xCurFld.Parent
    End If
Next xAccount
Set xDraftFld = Nothing
If xItemCount > 0 Then
   xPromptStr = "Are you sure to send out all the drafts?"
    xYesOrNo = MsgBox(xPromptStr, vbQuestion + vbYesNo, "Kutools for Outlook")
    If xYesOrNo = vbYes Then
        If Not xTmpFld Is Nothing Then
            Set Application.ActiveExplorer.CurrentFolder = xTmpFld
        End If
        VBA.DoEvents
        For Each xAccount In Outlook.Application.Session.Accounts
            Set xDraftFld = xAccount.DeliveryStore.GetDefaultFolder(olFolderDrafts)
            Set xDraftsItems = xDraftFld.Items
            For i = xDraftsItems.Count To 1 Step -1
                If xDraftsItems.Item(i).Recipients.Count <> 0 Then
                    xDraftsItems.Item(i).sEnd
                    xCount = xCount + 1
                End If
            Next
        Next xAccount
        VBA.DoEvents
        Set Application.ActiveExplorer.CurrentFolder = xCurFld
        MsgBox "Successfully sent " & xCount & " messages", vbInformation, "Kutools for Outlook"
    End If
Else
    MsgBox "No Drafts!", vbInformation + vbOKOnly, "Kutools for Outlook"
End If
End Sub

steps on sendig all draft messages at once in Outlook with VBA code

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

4. ستظهر نافذة حوار لتذكرك بعدد رسائل المسودات التي تم إرسالها، انظر الصورة:

5. وبعد ذلك انقر فوق زر موافق، سيتم إرسال جميع الرسائل الموجودة في مجلد المسودات دفعة واحدة، انظر الصورة:

ملاحظات:

1. الكود أعلاه سيرسل جميع رسائل المسودات من جميع الحسابات في Outlook الخاص بك.

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

كود VBA: إرسال الرسائل المختارة من مجلد المسودات:

Sub SendSelectedDraftEmails()
Dim xSelection As Selection
Dim xPromptStr As String
Dim xYesOrNo As Integer
Dim i As Long
Dim xAccount As Account
Dim xCurFld As Folder
Dim xDraftsFld As Folder
Dim xTmpFld As Folder
Dim xArr() As String
Dim xCount As Integer
Dim xMail As MailItem
On Error Resume Next
xCount = 0
Set xTmpFld = Nothing
Set xCurFld = Application.ActiveExplorer.CurrentFolder
For Each xAccount In Outlook.Application.Session.Accounts
    Set xDraftsFld = xAccount.DeliveryStore.GetDefaultFolder(olFolderDrafts)
    If xDraftsFld.EntryID = xCurFld.EntryID Then
        Set xTmpFld = xCurFld.Parent
    End If
Next xAccount
If xTmpFld Is Nothing Then
    MsgBox "The current folder is not a draft folder", vbInformation, "Kutools for Outlook"
    Exit Sub
End If
Set xSelection = Outlook.Application.ActiveExplorer.Selection
If xSelection.Count > 0 Then
    xPromptStr = "Are you sure to send out the selected " & xSelection.Count & " draft item(s)?"
    xYesOrNo = MsgBox(xPromptStr, vbQuestion + vbYesNo, "Kutools for Outlook")
    If xYesOrNo = vbYes Then
        ReDim xArr(xSelection.Count - 1)
        For i = 1 To xSelection.Count
            xArr(i - 1) = xSelection.Item(i).EntryID
        Next
        Set Application.ActiveExplorer.CurrentFolder = xTmpFld
        VBA.DoEvents
        For i = 0 To UBound(xArr)
            Set xMail = Application.Session.GetItemFromID(xArr(i))
            If xMail.Recipients.Count <> 0 Then
                xMail.sEnd
                xCount = xCount + 1
            End If
        Next
        VBA.DoEvents
        Set Application.ActiveExplorer.CurrentFolder = xCurFld
        MsgBox "Successfully sent " & xCount & " messages", vbInformation, "Kutools for Outlook"
    End If
Else
    MsgBox "No items selected!", vbInformation, "Kutools for Outlook"
End If
End Sub

مساعد البريد الإلكتروني الذكي في Outlook: ردود أذكى، تواصل أوضح (سحر بنقرة واحدة!) مجانًا

قم بتبسيط مهام Outlook اليومية باستخدام مساعد البريد الإلكتروني الذكي من أدوات Kutools لـ Outlook. هذا الأداة القوية تتعلم من رسائل البريد الإلكتروني السابقة لتقدم ردودًا ذكية ودقيقة، تحسين محتوى البريد الإلكتروني، وتساعدك على صياغة وتحسين الرسائل بسهولة.

هذه الميزة تدعم:

ردود ذكية: احصل على ردود مصممة من محادثاتك السابقة - مخصصة، دقيقة وجاهزة للإرسال.
تحسين المحتوى: قم بتحسين نصوص البريد الإلكتروني تلقائيًا لتحقيق الوضوح والتأثير.
الكتابة السهلة: فقط قدم الكلمات المفتاحية، ودع الذكاء الاصطناعي يتولى الباقي، مع أساليب كتابة متعددة.
التوسعات الذكية: قم بتوسيع أفكارك باقتراحات تعتمد على السياق.
الملخصات: احصل على ملخصات مختصرة للرسائل الطويلة فورًا.
التواصل العالمي: قم بترجمة رسائل البريد الإلكتروني إلى أي لغة بسهولة.

هذه الميزة تدعم: