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

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

如果您的“草稿”文件夾中有多個草稿郵件,而現在,您希望一次發送一次而不要一一發送。 您如何在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

3。 然後保存代碼,然後按 F5 鍵以運行此代碼,將彈出一個提示框,提醒您是否發送所有草稿,請單擊,請參見屏幕截圖:

4。 然後會彈出一個對話框,提醒您已發送了多少電子郵件草稿,請參見屏幕截圖:

5。 然後點擊 OK 按鈕中的所有電子郵件 草稿 文件夾將立即發送,請參見屏幕截圖:

筆記:

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中分別向多個收件人發送電子郵件?

如何通過Outlook從Excel向列表發送個性化大量電子郵件?

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

如何在Outlook中未知的情況下向多個收件人發送電子郵件?


Kutools for Outlook-為Outlook帶來100個高級功能,並使工作更加輕鬆!

  • 自動CC / BCC 根據規則發送電子郵件; 自動前進 自定義多封電子郵件; 自動回复 沒有交換服務器,還有更多自動功能...
  • BCC警告 -當您嘗試全部答复時顯示消息 如果您的郵件地址在“密件抄送”列表中; 缺少附件時提醒,還有更多提醒功能...
  • 在郵件對話中回复(全部)帶有所有附件; 回复許多電子郵件 片刻之間; 自動添加問候語 回复時將日期添加到主題中...
  • 附件工具:管理所有郵件中的所有附件, 自動分離, 全部壓縮,重命名全部,保存全部...快速報告, 計算選定的郵件...
  • 強大的垃圾郵件 習俗 刪除重複的郵件和聯繫人... 使您能夠在Outlook中做得更聰明,更快和更好。
拍攝kutools前景kutools選項卡1180x121
拍攝kutools前景kutools加標籤1180x121
 
按評論排序
留言 (15)
還沒有評分。 成為第一位評論!
網站主持人對此評論進行了最小化
太棒了,很有魅力,謝謝:)
網站主持人對此評論進行了最小化
einfach nur perfekt。 赫茲利興丹克
網站主持人對此評論進行了最小化
按上面複製,但是當我按 F5 時沒有任何反應
網站主持人對此評論進行了最小化
嗨,凱瑟琳,
以上代碼在我的 Outlook 中運行良好,您使用的是哪個 Outlook 版本?
網站主持人對此評論進行了最小化
我有多個交易所賬戶。 我想擁有一個不是我默認發件人的帳戶。 我會在哪裡插入這個代碼? 謝謝!
網站主持人對此評論進行了最小化
有人會收到一些電子郵件發送到已刪除的文件夾嗎?
網站主持人對此評論進行了最小化
嗨,比爾,
您想從已刪除的 foder 中發送多封選定的電子郵件嗎?
請把你的問題詳細一點,謝謝!
網站主持人對此評論進行了最小化
嗨skyyang,我面臨同樣的問題。 我通常起草 15-20 封電子郵件,然後使用此代碼一次性發送所有郵件,但後來意識到其中一封電子郵件沒有被發送,而是被發送到我的“已刪除”文件夾。 甚至提示也顯示了正確的電子郵件數量,例如:“已發送 20 封電子郵件”,但當我檢查時,只會發送 19 封,其中一封我會發現它位於我的已刪除項目文件夾中。 我希望所有電子郵件都正確無誤地發送給他們的收件人。 你能告訴我為什麼會這樣嗎? 請幫忙。
網站主持人對此評論進行了最小化
您好,Darewin,以上代碼已更新,請重試,謝謝!
網站主持人對此評論進行了最小化
同樣的問題:如果您選擇 4 條消息,在將其中 XNUMX 條發送到垃圾文件夾後(因為“xDraftsItems.Item(i).Delete”語句)
網站主持人對此評論進行了最小化
我們使用腳本一次發送所有草稿電子郵件,用於從 sage 200 生成的一批聲明電子郵件。發送項目中的電子郵件看起來不錯,但客戶正在接收它們,正文是中文! 有什麼想法可以在這裡發生嗎?
網站主持人對此評論進行了最小化
你能解釋一下為什麼最後一封郵件(i = 1)是在一個新的 MailItem 中重新創建的,而不僅僅是 .Send 嗎?

謝謝。
網站主持人對此評論進行了最小化
嗨,快速提問,也許你有一個想法。 我們有一個外部應用程序,可以將所有郵件保存到草稿文件夾。 如果我運行宏,我們會遇到問題,只有列表中的第一封郵件被正確發送,所有其他郵件都被推遲,因為它在郵件地址中添加了引號''。有沒有辦法避免這種情況?
網站主持人對此評論進行了最小化
此代碼將所有草稿發送到名為 Merge Tools 的子文件夾中(發送前會詢問您)。 我相信你們可以編輯它以滿足您的需求。 這要簡單得多。 享受 :)
子 SendAllMergeToolsDrafts()

if MsgBox("您確定要發送合併工具草稿文件夾中的所有項目嗎?", _
vbQuestion + vbYesNo) <> vbYes 然後退出 Sub

Dim myNamespace As Outlook.NameSpace '將視圖更改為收件箱以避免內聯錯誤
Set myNamespace = Application.GetNamespace("MAPI") '將視圖更改為收件箱以避免內聯錯誤
設置 Application.ActiveExplorer.CurrentFolder = _
myNamespace.GetDefaultFolder(olFolderInbox) '將視圖更改為收件箱以避免內聯錯誤

將 fldDraft 調暗為 MAPIFolder,msg 作為 Outlook.MailItem,intCount 作為整數
Set fldDraft = Outlook.GetNamespace("MAPI").GetDefaultFolder(olFolderDrafts).Folders("Merge Tools") '僅發送 Merge Tools 文件夾中的所有草稿
整數 = 0
當 fldDraft.Items.count > 0 時執行
設置 msg = fldDraft.Items(1)
msg.發送
整數計數 = 整數計數 + 1
循環
If Not (msg Is Nothing) 然後設置 msg = Nothing
設置 fldDraft = 無
MsgBox intCount & "發送的消息", vbInformation + vbOKOnly

END SUB
網站主持人對此評論進行了最小化
嗨,大家好。 以為我會分享。 這是我發送所有草稿的代碼:
Sub SendAllDrafts() '由 jamesmalcolmwood@gmail.com

if MsgBox("您確定要發送草稿文件夾中的所有項目嗎?", _
vbQuestion + vbYesNo) <> vbYes 然後退出 Sub

Dim myNamespace As Outlook.NameSpace '將視圖更改為收件箱以避免內聯錯誤
Set myNamespace = Application.GetNamespace("MAPI") '將視圖更改為收件箱以避免內聯錯誤
設置 Application.ActiveExplorer.CurrentFolder = _
myNamespace.GetDefaultFolder(olFolderInbox) '將視圖更改為收件箱以避免內聯錯誤

將 fldDraft 調暗為 MAPIFolder,msg 作為 Outlook.MailItem,intCount 作為整數
Set fldDraft = Outlook.GetNamespace("MAPI").GetDefaultFolder(olFolderDrafts) '發送主草稿文件夾中的所有草稿。 對於子文件夾,添加 .Folders("文件夾名稱")
整數 = 0
當 fldDraft.Items.count > 0 時執行
設置 msg = fldDraft.Items(1)
msg.發送
整數計數 = 整數計數 + 1
循環
If Not (msg Is Nothing) 然後設置 msg = Nothing
設置 fldDraft = 無
MsgBox intCount & "發送的消息", vbInformation + vbOKOnly

END SUB
這裡還沒有評論
留下你的意見
以訪客身份發帖
×
評價此帖子:
0   字符
推薦地點

關注我們

版權所有©2009 - 萬維網。extendoffice.com。 | 版權所有。 供電 ExtendOffice。 |
Microsoft和Office徽標是Microsoft Corporation在美國和/或其他國家的商標或註冊商標。
受Sectigo SSL保護