Skip to main content

如何在Outlook中一次發送多個草稿?

Author: Xiaoyang Last Modified: 2025-05-13

如果您的草稿文件夾中有許多草稿郵件,現在您希望一次性發送它們,而不是逐封發送。那麼在Outlook中該如何快速輕鬆地處理這個任務呢?

使用VBA代碼在Outlook中一次發送所有草稿郵件


使用VBA代碼在Outlook中一次發送所有草稿郵件

以下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 鍵運行此代碼,會彈出一個提示框詢問您是否要發送所有草稿,點擊 ,參見截圖:

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

4. 接著會彈出一個對話框提醒您有多少封草稿郵件已經被發送出去,參見截圖:

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

5. 點擊 確定 按鈕後,草稿文件夾中的所有郵件將一次性被發送出去,參見截圖:

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

注意:

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中的AI郵件助理:更聰明的回覆,更清晰的溝通(一鍵奇蹟!) 免費

使用Kutools for Outlook的AI郵件助理簡化您的日常Outlook任務。這個強大的工具會從您過去的郵件中學習,提供智能且準確的答覆,優化您的郵件內容,並幫助您輕鬆起草和潤色郵件。
doc ai email handle

此功能支援:

  • 智能回覆:根據您過去的對話獲得量身定制、精確且隨時可用的回覆。
  • 增強內容:自動優化您的郵件文字以提高清晰度和影響力。
  • 輕鬆撰寫:只需提供關鍵字,讓AI處理其餘部分,並有多種寫作風格可供選擇。
  • 智能擴展:通過上下文感知建議來拓展您的思路。
  • 摘要生成:即時獲取長郵件的簡潔概述。
  • 全球觸及:輕鬆將您的郵件翻譯成任何語言。

此功能支援:

  • 智能郵件回覆
  • 優化的內容
  • 基於關鍵字的草稿
  • 智能內容擴展
  • 郵件摘要生成
  • 多語言翻譯

最重要的是,此功能永遠完全免費不要再等待了——立即下載AI郵件助理並享受吧


相關文章:

如何在Outlook中分別向多位收件人單獨發送郵件?

如何通過Outlook從Excel列表中發送個性化的群發郵件?

如何在Outlook中分別向多位收件人單獨發送日曆?

如何在Outlook中向多位收件人發送郵件而不讓他們知道?