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

วิธีส่งแบบร่างหลายฉบับพร้อมกันใน 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 และทำให้การทำงานง่ายขึ้นมาก

  • CC อัตโนมัติ / BCC ตามกฎเมื่อส่งอีเมล ส่งต่ออัตโนมัติ อีเมลหลายฉบับโดยกำหนดเอง ตอบอัตโนมัติ ไม่มีเซิร์ฟเวอร์แลกเปลี่ยนและคุณสมบัติอัตโนมัติอื่น ๆ ...
  • คำเตือน BCC - แสดงข้อความเมื่อคุณพยายามตอบกลับทั้งหมด หากที่อยู่อีเมลของคุณอยู่ในรายการ BCC; เตือนเมื่อไม่มีไฟล์แนบและคุณสมบัติการเตือนอื่น ๆ ...
  • ตอบกลับ (ทั้งหมด) พร้อมไฟล์แนบทั้งหมดในการสนทนาทางไปรษณีย์; ตอบกลับอีเมลจำนวนมาก ในไม่กี่วินาที เพิ่มคำทักทายอัตโนมัติ เมื่อตอบกลับ; เพิ่มวันที่ในหัวเรื่อง ...
  • เครื่องมือแนบ: จัดการไฟล์แนบทั้งหมดในอีเมลทั้งหมด ถอดอัตโนมัติ, บีบอัดทั้งหมด, เปลี่ยนชื่อทั้งหมด, บันทึกทั้งหมด ... รายงานด่วน, นับอีเมลที่เลือก...
  • อีเมลขยะที่มีประสิทธิภาพ ตามธรรมเนียม; ลบอีเมลและผู้ติดต่อที่ซ้ำกัน... ช่วยให้คุณทำงานได้อย่างชาญฉลาดขึ้นเร็วขึ้นและดีขึ้นใน Outlook
shot kutools outlook แท็บ kutools 1180x121
shot kutools Outlook kutools plus แท็บ 1180x121
 
จัดเรียงความคิดเห็นโดย
ความคิดเห็น (15)
ยังไม่มีการให้คะแนน เป็นคนแรกที่ให้คะแนน!
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
Brilliant ทำงานมีเสน่ห์ ขอบคุณ :)
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
einfach nur สมบูรณ์แบบ Herzlichen Dank
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
คัดลอกตามด้านบน แต่เมื่อฉันกด F5 ไม่มีอะไรเกิดขึ้น
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดีคุณแคทลีน
รหัสด้านบนทำงานได้ดีใน Outlook ของฉัน คุณใช้ Outlook เวอร์ชันใด
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ฉันมีบัญชีแลกเปลี่ยนหลายบัญชี ฉันต้องการมีบัญชีที่ไม่ใช่บัญชีเริ่มต้นของฉันที่จะเป็นผู้ส่ง ฉันจะแทรกสิ่งนี้ในรหัสได้ที่ไหน ขอบคุณ!
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ใครได้รับอีเมลที่ส่งไปยังโฟลเดอร์ที่ถูกลบโดยทำเช่นนี้?
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดีบิล
คุณต้องการส่งอีเมลที่เลือกหลายฉบับจาก Foder ที่ถูกลบหรือไม่?
โปรดให้รายละเอียดปัญหาของคุณมากขึ้น ขอบคุณ!
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี skyyang ฉันประสบปัญหาเดียวกัน โดยปกติฉันจะร่างอีเมล 15-20 ฉบับแล้วใช้รหัสนี้เพื่อส่งทั้งหมดในคราวเดียว แต่ภายหลังพบว่าอีเมลเหล่านั้นไม่ได้ถูกส่งไป แต่จะถูกส่งไปยังโฟลเดอร์ 'ลบแล้ว' ของฉัน แม้แต่ข้อความแจ้งก็บอกว่าจำนวนอีเมลที่ถูกต้อง เช่น 'ส่งอีเมลแล้ว 20 ฉบับ' แต่เมื่อฉันตรวจสอบ จะมีการส่งเพียง 19 ฉบับเท่านั้น ฉันจะพบว่าอีเมลนั้นอยู่ในโฟลเดอร์รายการที่ถูกลบของฉัน ฉันต้องการให้อีเมลทั้งหมดถูกส่งไปยังผู้รับโดยไม่มีข้อผิดพลาด คุณช่วยบอกฉันหน่อยได้ไหมว่าทำไมสิ่งนี้ถึงเกิดขึ้น กรุณาช่วย.
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี Darewin เราได้อัปเดตรหัสข้างต้นแล้ว โปรดลองอีกครั้ง ขอบคุณ!
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ปัญหาเดียวกัน: หากคุณเลือก 4 ข้อความ หลังจากส่งสามข้อความ ar ในโฟลเดอร์ถังขยะ (เนื่องจากคำสั่ง "xDraftsItems.Item(i).Delete")
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
เราใช้สคริปต์เพื่อส่งอีเมลฉบับร่างทั้งหมดในคราวเดียวสำหรับชุดอีเมลคำสั่งที่สร้างจาก Sage 200 อีเมลในรายการที่ส่งนั้นดูดี แต่ลูกค้าได้รับข้อความเนื้อหาเป็นภาษาจีน! ความคิดใด ๆ ที่อาจเกิดขึ้นที่นี่?
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
คุณช่วยอธิบายได้ไหมว่าทำไมเมลสุดท้าย (i = 1) ถูกสร้างขึ้นใหม่ใน MailItem ใหม่แทนที่จะเป็นเพียง .Send

ขอบคุณ
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี คำถามด่วนบางทีคุณอาจมีไอเดีย เรามีแอปพลิเคชั่นภายนอกที่บันทึกเมลทั้งหมดไปยังโฟลเดอร์ร่างจดหมาย ถ้าฉันเรียกใช้มาโคร เรามีปัญหา ว่ามีเพียงอีเมลแรกในรายการที่ถูกส่งอย่างถูกต้อง อีเมลอื่น ๆ ทั้งหมดจะถูกเลื่อนออกไป เพราะมันเพิ่มเครื่องหมายคำพูด ' ' ไปยังที่อยู่เมล มีวิธีหลีกเลี่ยงสิ่งนี้หรือไม่
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
รหัสนี้จะส่งแบบร่างทั้งหมดในโฟลเดอร์ย่อยที่เรียกว่า Merge Tools (จะถามคุณก่อนส่ง) ฉันแน่ใจว่าพวกคุณสามารถแก้ไขได้เพื่อให้เหมาะกับความต้องการของคุณ มันง่ายกว่ามาก สนุก :)
ย่อย SendAllMergeToolsDrafts()

หาก MsgBox("คุณแน่ใจหรือไม่ว่าต้องการส่งรายการทั้งหมดในโฟลเดอร์ร่าง Merge Tools ของคุณ", _
vbQuestion + vbYesNo) <> vbYes แล้วออกจาก Sub

หรี่ myNamespace เป็น Outlook.NameSpace 'เปลี่ยนมุมมองเป็นกล่องจดหมายเข้าเพื่อหลีกเลี่ยงข้อผิดพลาดแบบอินไลน์
ตั้งค่า myNamespace = Application.GetNamespace("MAPI") 'เปลี่ยนมุมมองเป็นกล่องจดหมายเข้าเพื่อหลีกเลี่ยงข้อผิดพลาดในบรรทัด
ตั้งค่า Application.ActiveExplorer.CurrentFolder = _
myNamespace.GetDefaultFolder(olFolderInbox) 'เปลี่ยนมุมมองเป็น Inbox เพื่อหลีกเลี่ยงข้อผิดพลาดในบรรทัด

Dim fldDraft เป็น MAPIFolder, msg As Outlook.MailItem, intCount As Integer
Set fldDraft = Outlook.GetNamespace("MAPI")).GetDefaultFolder(olFolderDrafts).Folders("Merge Tools") 'ส่งแบบร่างทั้งหมดในโฟลเดอร์ Merge Tools เท่านั้น
intCount = 0
ทำในขณะที่ fldDraft.Items.count > 0
ชุดข้อความ = fldDraft.Items(1)
msg.ส่ง
intCount = intCount + 1
ห่วง
ถ้าไม่ (msg Is Nothing) จากนั้น Set msg = Nothing
ตั้งค่า fldDraft = Nothing
MsgBox intCount & " ข้อความที่ส่ง", vbInformation + vbOKOnly

ย่อยสิ้นสุด
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดีพวก คิดว่าฉันจะแบ่งปัน นี่คือรหัสของฉันสำหรับส่งร่างจดหมายทั้งหมด:
Sub SendAllDrafts() 'โดย jamesmalcolmwood@gmail.com

หาก MsgBox("คุณแน่ใจหรือไม่ว่าต้องการส่งรายการทั้งหมดในโฟลเดอร์ร่างจดหมายของคุณ", _
vbQuestion + vbYesNo) <> vbYes แล้วออกจาก Sub

หรี่ myNamespace เป็น Outlook.NameSpace 'เปลี่ยนมุมมองเป็นกล่องจดหมายเข้าเพื่อหลีกเลี่ยงข้อผิดพลาดแบบอินไลน์
ตั้งค่า myNamespace = Application.GetNamespace("MAPI") 'เปลี่ยนมุมมองเป็นกล่องจดหมายเข้าเพื่อหลีกเลี่ยงข้อผิดพลาดในบรรทัด
ตั้งค่า Application.ActiveExplorer.CurrentFolder = _
myNamespace.GetDefaultFolder(olFolderInbox) 'เปลี่ยนมุมมองเป็น Inbox เพื่อหลีกเลี่ยงข้อผิดพลาดในบรรทัด

Dim fldDraft เป็น MAPIFolder, msg As Outlook.MailItem, intCount As Integer
ตั้งค่า fldDraft = Outlook.GetNamespace("MAPI")).GetDefaultFolder(olFolderDrafts) 'ส่งร่างจดหมายทั้งหมดในโฟลเดอร์ร่างหลักของคุณ สำหรับโฟลเดอร์ย่อย ให้เพิ่ม .Folders("folder name")
intCount = 0
ทำในขณะที่ fldDraft.Items.count > 0
ชุดข้อความ = fldDraft.Items(1)
msg.ส่ง
intCount = intCount + 1
ห่วง
ถ้าไม่ (msg Is Nothing) จากนั้น Set msg = Nothing
ตั้งค่า fldDraft = Nothing
MsgBox intCount & " ข้อความที่ส่ง", vbInformation + vbOKOnly

ย่อยสิ้นสุด
มีความคิดเห็นยังไม่มีการโพสต์ที่นี่
แสดงความคิดเห็นของคุณ
โพสต์ในฐานะแขก
×
ให้คะแนนโพสต์นี้:
0   ตัวอักษร
สถานที่แนะนำ

ช่องทางอื่นๆ

ลิขสิทธิ์© 2009 - wwwextendoffice.com | สงวนลิขสิทธิ์. ขับเคลื่อนโดย ExtendOffice. | แผนผังเว็บไซต์
Microsoft และโลโก้ Office เป็นเครื่องหมายการค้าหรือเครื่องหมายการค้าจดทะเบียนของ Microsoft Corporation ในสหรัฐอเมริกาและ / หรือประเทศอื่น ๆ
ได้รับการปกป้องโดย Sectigo SSL