Note: The other languages of the website are Google-translated. Back to English

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

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

أرسل جميع رسائل المسودات مرة واحدة في Outlook برمز VBA


أرسل جميع رسائل المسودات مرة واحدة في Outlook برمز VBA

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

1. اضغط باستمرار على ALT + F11 مفاتيح لفتح ميكروسوفت فيسوال باسيك للتطبيقات نافذة.

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

كود فبا: أرسل كل مسودات رسائل البريد الإلكتروني مرة واحدة في 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. ثم انقر فوق OK الزر ، جميع رسائل البريد الإلكتروني الموجودة في ملف الداما سيتم إرسال المجلد مرة واحدة ، انظر الصورة:

الملاحظات:

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

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

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

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؟


Kutools for Outlook - يجلب 100 ميزة متقدمة إلى Outlook ، ويجعل العمل أسهل كثيرًا!

  • CC السيارات / BCC حسب القواعد عند إرسال البريد الإلكتروني ؛ إعادة توجيه تلقائي رسائل بريد إلكتروني متعددة حسب الطلب ؛ رد آلي بدون خادم صرف ، والمزيد من الميزات التلقائية ...
  • تحذير BCC - إظهار الرسالة عند محاولة الرد على الكل إذا كان عنوان بريدك في قائمة BCC; تذكير عند فقدان المرفقات، والمزيد من ميزات التذكير ...
  • رد (الكل) بكل المرفقات في محادثة البريد; الرد على العديد من رسائل البريد الإلكتروني في ثوان؛ إضافة تحية تلقائية عند الرد إضافة التاريخ إلى الموضوع ...
  • أدوات المرفقات: إدارة جميع المرفقات في جميع الرسائل ، فصل تلقائي, ضغط الكل، إعادة تسمية الكل ، حفظ الكل ... تقرير سريع ، عد الرسائل المختارة
  • رسائل البريد الإلكتروني غير الهامة القوية حسب العرف قم بإزالة الرسائل المكررة وجهات الاتصال تمكنك من أداء أذكى وأسرع وأفضل في Outlook.
لقطة kutools outlook kutools tab 1180x121
لقطة kutools outlook kutools plus tab 1180x121
 
فرز التعليقات حسب
التعليقات (15)
لا يوجد تقييم. كن أول من يقيم!
تم تصغير هذا التعليق بواسطة المشرف على الموقع
رائعة ، عملت بسحر ، شكرا لك :)
تم تصغير هذا التعليق بواسطة المشرف على الموقع
einfach nur perfekt. هرتسلتشين دانك
تم تصغير هذا التعليق بواسطة المشرف على الموقع
تم نسخه كما هو مذكور أعلاه ولكن عندما أضغط على F5 لا يحدث شيء
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبًا كاثلين ،
يعمل الكود أعلاه بشكل جيد في برنامج Outlook الخاص بي ، ما هو إصدار Outlook الذي تستخدمه؟
تم تصغير هذا التعليق بواسطة المشرف على الموقع
لدي حسابات صرف متعددة. أرغب في أن يكون لدي أحد الحسابات التي ليست افتراضيًا ليكون المرسل. أين يمكنني إدخال هذا في الكود؟ شكرًا!
تم تصغير هذا التعليق بواسطة المشرف على الموقع
هل حصل أي شخص على بعض رسائل البريد الإلكتروني المرسلة إلى المجلد المحذوف للقيام بذلك؟
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبا بيل،
هل تريد إرسال رسائل بريد إلكتروني متعددة محددة من العارض المحذوف؟
من فضلك أعط مشكلتك أكثر تفصيلا ، شكرا لك!
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبًا سكاي يانغ ، أواجه نفس المشكلة. عادةً ما أقوم بإعداد مسودات من 15 إلى 20 رسالة بريد إلكتروني ثم استخدم هذا الرمز لإرسالها جميعًا مرة واحدة ، لكنني أدرك لاحقًا أن إحدى رسائل البريد الإلكتروني هذه لا يتم إرسالها ، بل يتم إرسالها إلى مجلد "المحذوفة". حتى المطالبة تقول العدد الصحيح من رسائل البريد الإلكتروني على سبيل المثال: "20 بريدًا إلكترونيًا تم إرسالها" ولكن عندما أتحقق من ذلك ، كان سيتم إرسال 19 بريدًا فقط ، وسوف أجدها في مجلد العناصر المحذوفة. أريد أن يتم إرسال جميع رسائل البريد الإلكتروني إلى مستلميها دون أخطاء. هل يمكنك أن تخبرني لماذا يحدث هذا. الرجاء المساعدة.
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبًا Darewin ، لقد قمنا بتحديث الرموز أعلاه ، يرجى المحاولة مرة أخرى ، شكرًا لك!
تم تصغير هذا التعليق بواسطة المشرف على الموقع
نفس المشكلة: إذا قمت بتحديد 4 رسائل ، بعد إرسال ثلاثة منهم في مجلد المهملات (بسبب العبارة "xDraftsItems.Item (i) .Delete")
تم تصغير هذا التعليق بواسطة المشرف على الموقع
استخدمنا البرنامج النصي لإرسال جميع رسائل البريد الإلكتروني في وقت واحد لمجموعة من رسائل البريد الإلكتروني الخاصة بالبيانات التي تم إنشاؤها من sage 200. تبدو رسائل البريد الإلكتروني في العناصر المرسلة جيدة ولكن العملاء يستقبلونها مع النص الأساسي باللغة الصينية! أي أفكار ماذا يمكن أن يحدث هنا؟
تم تصغير هذا التعليق بواسطة المشرف على الموقع
هل يمكنك توضيح سبب إعادة إنشاء آخر بريد (i = 1) في MailItem جديد بدلاً من إرسال فقط؟

شكر.
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبًا ، سؤال سريع ربما لديك فكرة. لدينا تطبيق خارجي يحفظ جميع الرسائل في مجلد المسودات. إذا قمت بتشغيل الماكرو ، فلدينا مشكلة ، حيث يتم إرسال البريد الأول فقط في القائمة بشكل صحيح ، ويتم تأجيل جميع الرسائل الأخرى لأنه يضيف علامات اقتباس إلى عنوان البريد. هل هناك طريقة لتجنب ذلك؟
تم تصغير هذا التعليق بواسطة المشرف على الموقع
يرسل هذا الرمز جميع المسودات في مجلد فرعي يسمى أدوات الدمج (يسألك قبل الإرسال). أنا متأكد من أنكم يمكنكم تعديله ليناسب احتياجاتكم بالرغم من ذلك. إنه أبسط بكثير. يتمتع :)
Sub SendAllMergeToolsDrafts ()

إذا كانت MsgBox ("هل أنت متأكد من أنك تريد إرسال كافة العناصر الموجودة في مجلد مسودات أدوات الدمج؟" ، _
vbQuestion + vbYesNo) <> vbYes ثم الخروج من Sub

قم بتعتيم مساحة myNamespace باسم Outlook.NameSpace ، قم بتغيير العرض إلى علبة الوارد لتجنب الخطأ المضمّن
تعيين myNamespace = Application.GetNamespace ("MAPI") 'تغيير العرض إلى Inbox لتجنب الخطأ المضمّن
قم بتعيين Application.ActiveExplorer.CurrentFolder = _
myNamespace.GetDefaultFolder (olFolderInbox) 'تغيير العرض إلى Inbox لتجنب الخطأ المضمن

خافت fldDraft كمجلد MAPIF ، msg كـ Outlook.MailItem ، intCount كعدد صحيح
تعيين fldDraft = Outlook.GetNamespace ("MAPI"). GetDefaultFolder (olFolderDrafts). المجلدات ("أدوات الدمج") 'ترسل جميع المسودات في مجلد أدوات الدمج فقط
intCount = 0
افعل بينما fldDraft.ems.count> 0
ضبط msg = fldDraft. العناصر (1)
إرسال
intCount = intCount + 1
أنشوطة
إذا لم يكن الأمر كذلك (الرسالة لا شيء) ، فقم بتعيين msg = لا شيء
تعيين fldDraft = لا شيء
إدخال MsgBox & "الرسائل المرسلة" ، vbInformation + vbOKOnly

نهاية الفرعية
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبا الرجال. اعتقدت أن أشارك. هذا هو الكود الخاص بي لإرسال جميع المسودات:
Sub SendAllDrafts () "بواسطة jamesmalcolmwood@gmail.com

إذا كانت MsgBox ("هل أنت متأكد من أنك تريد إرسال كافة العناصر الموجودة في مجلد المسودات؟" ، _
vbQuestion + vbYesNo) <> vbYes ثم الخروج من Sub

قم بتعتيم مساحة myNamespace باسم Outlook.NameSpace ، قم بتغيير العرض إلى علبة الوارد لتجنب الخطأ المضمّن
تعيين myNamespace = Application.GetNamespace ("MAPI") 'تغيير العرض إلى Inbox لتجنب الخطأ المضمّن
قم بتعيين Application.ActiveExplorer.CurrentFolder = _
myNamespace.GetDefaultFolder (olFolderInbox) 'تغيير العرض إلى Inbox لتجنب الخطأ المضمن

خافت fldDraft كمجلد MAPIF ، msg كـ Outlook.MailItem ، intCount كعدد صحيح
Set fldDraft = Outlook.GetNamespace ("MAPI"). GetDefaultFolder (olFolderDrafts) "يرسل كافة المسودات في مجلد المسودات الرئيسي. بالنسبة لمجلد فرعي ، أضف مجلدات ("اسم المجلد")
intCount = 0
افعل بينما fldDraft.ems.count> 0
ضبط msg = fldDraft. العناصر (1)
إرسال
intCount = intCount + 1
أنشوطة
إذا لم يكن الأمر كذلك (الرسالة لا شيء) ، فقم بتعيين msg = لا شيء
تعيين fldDraft = لا شيء
إدخال MsgBox & "الرسائل المرسلة" ، vbInformation + vbOKOnly

نهاية الفرعية
لا توجد تعليقات منشورة هنا حتى الآن
اترك تعليقاتك
النشر كضيف
×
قيم المنشور:
0   الشخصيات
المواقع المقترحة

تواصل معنا

حقوق التأليف والنشر © 2009 - شبكة الاتصالات العالمية.extendoffice.com. | كل الحقوق محفوظة. مشغل بواسطة ExtendOffice. | | خريطة الموقع
Microsoft وشعار Office هما علامتان تجاريتان أو علامتان تجاريتان مسجلتان لشركة Microsoft Corporation في الولايات المتحدة و / أو دول أخرى.
محمي بواسطة Sectigo SSL