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?


Kutools for Outlook - Brings 100 Advanced Features to Outlook, and Make Work Much Easier!

  • Auto CC/BCC by rules when sending email; Auto Forward Multiple Emails by custom; Auto Reply without exchange server, and more automatic features...
  • BCC Warning - show message when you try to reply all if your mail address is in the BCC list; Remind When Missing Attachments, and more remind features...
  • Reply (All) With All Attachments in the mail conversation; Reply Many Emails in seconds; Auto Add Greeting when reply; Add Date into subject...
  • Attachment Tools: Manage All Attachments in All Mails, Auto Detach, Compress All, Rename All, Save All... Quick Report, Count Selected Mails...
  • Powerful Junk Emails by custom; Remove Duplicate Mails and Contacts... Enable you to do smarter, faster and better in Outlook.
shot kutools outlook kutools tab 1180x121
shot kutools outlook kutools plus tab 1180x121
 
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.
    Lukas · 5 months ago
    Can you explain why the last mail (i = 1) is recreated in a new MailItem instead of just .Send?

    Thanks.
  • To post as a guest, your comment is unpublished.
    Dennis · 5 months ago
    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?
  • To post as a guest, your comment is unpublished.
    Bill · 8 months ago
    Anybody get some emails sent to the deleted folder doing this?
    • To post as a guest, your comment is unpublished.
      Frank · 4 months ago
      Same problem: if you select 4 messages, after sending three of them ar in trash folder (because of the "xDraftsItems.Item(i).Delete" statement)
    • To post as a guest, your comment is unpublished.
      skyyang · 8 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 · 10 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 · 1 years ago
    Copied as per above but when I press F5 nothing happens
    • To post as a guest, your comment is unpublished.
      skyyang · 1 years 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 · 1 years ago
    Brilliant, worked a charm, thank you :)