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

إذا كانت هناك عدة رسائل مسودة في مجلد المسودات وترغب في إرسالها جميعًا دفعة واحدة—بدون الحاجة إلى إرسالها واحدة تلو الأخرى—فكيف يمكنك تنفيذ هذه المهمة بسرعة وسهولة في 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

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؟

كيف تُرسل رسائل بريد إلكتروني جماعية مخصصة إلى قائمة جهات اتصال من Excel عبر Outlook؟

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

كيف تُرسل رسالة بريد إلكتروني إلى عدة مستلمين في Outlook دون أن يعلم أيٌّ منهم بوجود الآخرين؟