ไปยังเนื้อหาหลัก

วิธีส่งแบบร่างหลายฉบับพร้อมกันใน Outlook

หากมีข้อความร่างหลายข้อความในโฟลเดอร์แบบร่างของคุณและตอนนี้คุณต้องการส่งพร้อมกันโดยไม่ต้องส่งทีละข้อความ คุณจะจัดการกับงานนี้อย่างรวดเร็วและง่ายดายใน Outlook ได้อย่างไร?

ส่งข้อความร่างทั้งหมดพร้อมกันใน Outlook ด้วยรหัส VBA


ส่งข้อความร่างทั้งหมดพร้อมกันใน Outlook ด้วยรหัส VBA

รหัส VBA ต่อไปนี้สามารถช่วยให้คุณส่งอีเมลฉบับร่างทั้งหมดหรือที่เลือกจากโฟลเดอร์ Drafts พร้อมกันได้โปรดดำเนินการดังนี้:

1. กด ALT + F11 คีย์เพื่อเปิด Microsoft Visual Basic สำหรับแอปพลิเคชัน หน้าต่าง

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. จากนั้นคลิก OK อีเมลทั้งหมดในไฟล์ ร่าง โฟลเดอร์จะถูกส่งพร้อมกันดูภาพหน้าจอ:

หมายเหตุ:

1. รหัสด้านบนจะส่งอีเมลฉบับร่างทั้งหมดจากบัญชีทั้งหมดใน Outlook ของคุณ

2. หากคุณต้องการส่งอีเมลบางฉบับจากโฟลเดอร์ Drafts โปรดใช้รหัส 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


สุดยอดเครื่องมือเพิ่มผลผลิตในสำนักงาน

Kutools สำหรับ Outlook - คุณสมบัติอันทรงพลังมากกว่า 100 รายการเพื่อเติมพลังให้กับ Outlook ของคุณ

📧 การทำงานอัตโนมัติของอีเมล: ไม่อยู่ที่สำนักงาน (ใช้ได้กับ POP และ IMAP)  /  กำหนดการส่งอีเมล  /  Auto CC/BCC ตามกฎเมื่อส่งอีเมล  /  ส่งต่ออัตโนมัติ (กฎขั้นสูง)   /  เพิ่มคำทักทายอัตโนมัติ   /  แบ่งอีเมลผู้รับหลายรายออกเป็นข้อความส่วนตัวโดยอัตโนมัติ ...

📨 การจัดการอีเมล์: เรียกคืนอีเมลได้อย่างง่ายดาย  /  บล็อกอีเมลหลอกลวงตามหัวเรื่องและอื่นๆ  /  ลบอีเมลที่ซ้ำกัน  /  การค้นหาขั้นสูง  /  รวมโฟลเดอร์ ...

📁 ไฟล์แนบโปรบันทึกแบทช์  /  การแยกแบทช์  /  การบีบอัดแบบแบตช์  /  บันทึกอัตโนมัติ   /  ถอดอัตโนมัติ  /  บีบอัดอัตโนมัติ ...

🌟 อินเตอร์เฟซเมจิก: 😊อีโมจิที่สวยและเจ๋งยิ่งขึ้น   /  เพิ่มประสิทธิภาพการทำงาน Outlook ของคุณด้วยมุมมองแบบแท็บ  /  ลดขนาด Outlook แทนที่จะปิด ...

???? เพียงคลิกเดียวสิ่งมหัศจรรย์: ตอบกลับทั้งหมดด้วยไฟล์แนบที่เข้ามา  /   อีเมลต่อต้านฟิชชิ่ง  /  🕘 แสดงโซนเวลาของผู้ส่ง ...

👩🏼‍🤝‍👩🏻 รายชื่อและปฏิทิน: แบทช์เพิ่มผู้ติดต่อจากอีเมลที่เลือก  /  แบ่งกลุ่มผู้ติดต่อเป็นกลุ่มแต่ละกลุ่ม  /  ลบการแจ้งเตือนวันเกิด ...

เกิน คุณสมบัติ 100 รอการสำรวจของคุณ! คลิกที่นี่เพื่อค้นพบเพิ่มเติม

 

 

Comments (15)
No ratings yet. Be the first to rate!
This comment was minimized by the moderator on the site
Hi guys. Thought I'd share. Here's my code for sending all drafts:
Sub SendAllDrafts() 'By

If MsgBox("Are you sure you want to send ALL the items in your drafts folder?", _
vbQuestion + vbYesNo) <> vbYes Then Exit Sub

Dim myNamespace As Outlook.NameSpace 'Change view to Inbox to avoid inline error
Set myNamespace = Application.GetNamespace("MAPI") 'Change view to Inbox to avoid inline error
Set Application.ActiveExplorer.CurrentFolder = _
myNamespace.GetDefaultFolder(olFolderInbox) 'Change view to Inbox to avoid inline error

Dim fldDraft As MAPIFolder, msg As Outlook.MailItem, intCount As Integer
Set fldDraft = Outlook.GetNamespace("MAPI").GetDefaultFolder(olFolderDrafts) 'Sends all drafts in your main drafts folder. For a subfolder, add .Folders("folder name")
intCount = 0
Do While fldDraft.Items.count > 0
Set msg = fldDraft.Items(1)
msg.Send
intCount = intCount + 1
Loop
If Not (msg Is Nothing) Then Set msg = Nothing
Set fldDraft = Nothing
MsgBox intCount & " messages sent", vbInformation + vbOKOnly

End Sub
This comment was minimized by the moderator on the site
This code sends all drafts in a subfolder called Merge Tools (it asks you before sending). I'm sure you guys can edit it to suit your needs though. It's far simpler. Enjoy :)
Sub SendAllMergeToolsDrafts()

If MsgBox("Are you sure you want to send ALL the items in your Merge Tools drafts folder?", _
vbQuestion + vbYesNo) <> vbYes Then Exit Sub

Dim myNamespace As Outlook.NameSpace 'Change view to Inbox to avoid inline error
Set myNamespace = Application.GetNamespace("MAPI") 'Change view to Inbox to avoid inline error
Set Application.ActiveExplorer.CurrentFolder = _
myNamespace.GetDefaultFolder(olFolderInbox) 'Change view to Inbox to avoid inline error

Dim fldDraft As MAPIFolder, msg As Outlook.MailItem, intCount As Integer
Set fldDraft = Outlook.GetNamespace("MAPI").GetDefaultFolder(olFolderDrafts).Folders("Merge Tools") 'Sends all drafts in the Merge Tools folder only
intCount = 0
Do While fldDraft.Items.count > 0
Set msg = fldDraft.Items(1)
msg.Send
intCount = intCount + 1
Loop
If Not (msg Is Nothing) Then Set msg = Nothing
Set fldDraft = Nothing
MsgBox intCount & " messages sent", vbInformation + vbOKOnly

End Sub
This comment was minimized by the moderator on the site
Hi, quick question maybe you have an Idea. We have an external application that saves all mails to the drafts folder. if i run the macro we have the problem, that only the first mail in the list is beeing sent correctly, all other mails are deferred because it adds quote marks ' ' to the mail adress.Is there a way to avoid this?
This comment was minimized by the moderator on the site
Can you explain why the last mail (i = 1) is recreated in a new MailItem instead of just .Send?

Thanks.
This comment was minimized by the moderator on the site
We used the script to send all draft emails at once for a batch of statement emails generated from sage 200. The emails in the sent items look fine but customers are are receiving them with the body text in Chinese! Any ideas what could be happening here?
This comment was minimized by the moderator on the site
Anybody get some emails sent to the deleted folder doing this?
This comment was minimized by the moderator on the site
Same problem: if you select 4 messages, after sending three of them ar in trash folder (because of the "xDraftsItems.Item(i).Delete" statement)
This comment was minimized by the moderator on the site
Hi, Bill,
Do you want to send multiple selected emails from deleted foder?
Please give your problem more detailed, thank you!
This comment was minimized by the moderator on the site
Hi skyyang, Im facing the same problem. I draft usually 15-20 emails and then use this code to send them all at once, but later realise that one of those emails do not get sent, rather they are sent to my 'Deleted' folder. Even the prompt says the correct number of emails for eg: '20 emails sent' but when I check, only 19 would have been sent, one I will find it lying in my deleted items folder. I want all the emails to be sent to their recipients without error. Can you please tell me why this happens. Please help.
This comment was minimized by the moderator on the site
Hi, Darewin,We have updated the above codes, please try again, thank you!
This comment was minimized by the moderator on the site
I have multiple exchange accounts. I want to have one of the accounts that isn't my default to be the sender. Where would I insert this in the code? Thanks!
This comment was minimized by the moderator on the site
Copied as per above but when I press F5 nothing happens
This comment was minimized by the moderator on the site
Hi, Cathleen,
The above code works fine in my Outlook, which Outlook version do you use?
This comment was minimized by the moderator on the site
Brilliant, worked a charm, thank you :)
This comment was minimized by the moderator on the site
einfach nur perfekt. Herzlichen Dank
There are no comments posted here yet
Please leave your comments in English
Posting as Guest
×
Rate this post:
0   Characters
Suggested Locations