<< Click to Display Table of Contents >> Navigation:  Reports > Send all drafts in Outlook

When creating E-mails from Mill7, it is possible to save them as drafts.

 

By default it is not possible to send all E-mails that are saved to your drafts folder in Outlook.

There is however a script that can be added to Outlook.

 

Setup

 

Step 1:

 

In outlook: File > Options > Trust center > Trust center settings > Macro settings > Notification for all macros

 

Step 2:

 

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

 

Step 3:

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

 

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

 

Step 4:

Save and close the scherm

 

Step 5:

Restart Outlook so the new settings are loaded

 

 

Run

1.        Open your Drafts folder and select all e-mails you want to send.

2.        Press ALT-F11

3.        The screen will now open with the script, press F5.

4.        Press Yes

5.        Ready!