Tip: Other languages are Google-Translated. You can visit the English version of this link.
Log in
x
or
x
x
Register
x

or

How to send multiple drafts at once in Outlook?

If there are multiple draft messages in your Drafts folder, and now, you want to send them at once without sending one by one. How could you deal with this job quickly and easily in Outlook?

Send all draft messages at once in Outlook with VBA code


Reply all selected emails at once:

If you have multiple emails needed to be replied, rely them one by one will waste much time, but, with Kutools for Outlook's Bulk Reply feature, you can solve this job as quickly as you could.

Kutools for Outlook: with more than 20+ handy Excel add-ins, free to try with no limitation in 60 days. Download and try the free trial now!

Send all draft messages at once in Outlook with VBA code

The following VBA codes can help you to send all or selected draft emails from the Drafts folder at once, please do as this:

1. Hold down the ALT + F11 keys to open the Microsoft Visual Basic for Applications window.

2. Then click Insert > Module, copy and paste below code into the opened blank module, see screenshot:

VBA code: Send all draft emails at once in Outlook:

Sub SendAllDraftEmails()
Dim xAccount As Account
Dim xDraftFld As Folder
Dim xItemCount As Integer
Dim xDraftsItems As Outlook.Items
Dim xPromptStr As String
Dim xYesOrNo As Integer
Dim i, k As Long
Dim xNewMail As MailItem
Dim xTmpPath, xFilePath As String
On Error Resume Next
xItemCount = 0
For Each xAccount In Outlook.Application.Session.Accounts
    Set xDraftFld = xAccount.DeliveryStore.GetDefaultFolder(olFolderDrafts)
    xItemCount = xItemCount + xDraftFld.Items.Count
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
        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 i = 1 Then
                    Set xNewMail = Outlook.Application.CreateItem(olMailItem)
                    With xNewMail
                        .SendUsingAccount = xDraftsItems.Item(i).SendUsingAccount
                        .To = xDraftsItems.Item(i).To
                        .CC = xDraftsItems.Item(i).CC
                        .BCC = xDraftsItems.Item(i).BCC
                        .Subject = xDraftsItems.Item(i).Subject
                        If xDraftsItems.Item(i).Attachments.Count > 0 Then
                            xTmpPath = "C:\MyTempAttachments"
                            If Dir(xTmpPath, vbDirectory) = "" Then
                                MkDir xTmpPath
                            End If
                            For k = xDraftsItems.Item(i).Attachments.Count To 1 Step -1
                                xFilePath = xTmpPath & "\" & xDraftsItems.Item(i).Attachments.Item(k).FileName
                                xDraftsItems.Item(i).Attachments.Item(k).SaveAsFile xFilePath
                                xNewMail.Attachments.Add (xFilePath)
                                Kill xFilePath
                            Next k
                            RmDir xTmpPath
                        End If
                        .HTMLBody = xDraftsItems.Item(i).HTMLBody
                        .Send
                    End With
                    xDraftsItems.Item(i).Delete
                Else
                    xDraftsItems.Item(i).Send
                End If
            Next
        Next xAccount
        MsgBox "Successfully sent " & xItemCount & " messages", vbInformation, "Kutools for Outlook"
    End If
Else
    MsgBox "No Drafts!", vbInformation + vbOKOnly, "Kutools for Outlook"
End If
End Sub

3. Then save the code, and press F5 key to run this code, a prompt box will pop up to remind you if send all the drafts, click Yes, see screenshot:

4. And a dialog box will pop out to remind you how many draft emails have been sent out, see screenshot:

5. And then click OK button, all the emails in the Drafts folder will be sent at once, see screenshot:

Notes:

1. The above code will send all draft emails from all accounts in your Outlook.

2. If you just want to send some specific emails from the Drafts folder, please apply the following VBA code:

VBA code: Send selected emails from the Drafts folder:

Sub SendSelectedDraftEmails()
Dim xSelection As Selection
Dim xPromptStr As String
Dim xYesOrNo As Integer
Dim i As Long
Dim xNewMail As MailItem
Dim xTmpPath, xFilePath As String
On Error Resume Next
If Outlook.Application.Session.GetDefaultFolder(olFolderDrafts).Name <> _
   Outlook.Application.ActiveExplorer.CurrentFolder.Name 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
      For i = xSelection.Count To 1 Step -1
          If i = 1 Then
              Set xNewMail = Outlook.Application.CreateItem(olMailItem)
              With xNewMail
                  .SendUsingAccount = xSelection.Item(i).SendUsingAccount
                  .To = xSelection.Item(i).To
                  .CC = xSelection.Item(i).CC
                  .BCC = xSelection.Item(i).BCC
                  .Subject = xSelection.Item(i).Subject
                   If xSelection.Item(i).Attachments.Count > 0 Then
                      xTmpPath = "C:\MyTempAttachments"
                      If Dir(xTmpPath, vbDirectory) = "" Then
                          MkDir xTmpPath
                      End If
                      For k = xSelection.Item(i).Attachments.Count To 1 Step -1
                          xFilePath = xTmpPath & "\" & xSelection.Item(i).Attachments.Item(k).FileName
                          xSelection.Item(i).Attachments.Item(k).SaveAsFile xFilePath
                          xNewMail.Attachments.Add (xFilePath)
                          Kill xFilePath
                      Next k
                      RmDir xTmpPath
                  End If
                  .HTMLBody = xSelection.Item(i).HTMLBody
                  .Send
              End With
              xSelection.Item(i).Delete
          Else
              xSelection.Item(i).Send
          End If
      Next
      MsgBox "Successfully sent " & xSelection.Count & " messages", vbInformation, "Kutools for Outlook"
   End If
Else
   MsgBox "No items selected!", vbInformation, "Kutools for Outlook"
End If
End Sub

Related Articles:

How To Send An Email To Multiple Recipients Individually In Outlook?

How To Send Personalized Mass Emails To A List From Excel Via Outlook?

How To Send A Calendar To Multiple Recipients Individually In Outlook?

How To Send Email To Multiple Recipients Without Them Knowing In Outlook?

 

Recommended Productivity Tools

shot kutools outlook kutools tab 1180x121
shot kutools outlook kutools plus tab 1180x121

Kutools for Outlook - More than 100 Advanced Functions for Outlook, Improve 70% Efficiency For you

  • Complicated and repeated operations can be done a one-time processing in seconds.
  • Forward multiple emails individually with one-click, and auto forward by rules.
  • Auto CC/BCC every sending email and easy for customizing rules, and auto reply without requiring exchange server.
  • Powerful junk emails filter, remove duplicate emails, reply with attachment, bunch of one-click operations, and so on...
  • 60-day unlimited free trial. 60-day money back guarantee. 2 years free upgrade and support. Buy once, use forever.
Say something here...
symbols left.
You are guest ( Sign Up? )
or post as a guest, but your post won't be published automatically.
Loading comment... The comment will be refreshed after 00:00.
  • To post as a guest, your comment is unpublished.
    Bill · 1 months ago
    Anybody get some emails sent to the deleted folder doing this?
    • To post as a guest, your comment is unpublished.
      skyyang · 1 months ago
      Hi, Bill,
      Do you want to send multiple selected emails from deleted foder?
      Please give your problem more detailed, thank you!
  • To post as a guest, your comment is unpublished.
    Donnie · 3 months ago
    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!
  • To post as a guest, your comment is unpublished.
    Cathleen · 5 months ago
    Copied as per above but when I press F5 nothing happens
    • To post as a guest, your comment is unpublished.
      skyyang · 5 months ago
      Hi, Cathleen,
      The above code works fine in my Outlook, which Outlook version do you use?
  • To post as a guest, your comment is unpublished.
    Colin · 10 months ago
    Brilliant, worked a charm, thank you :)