#  Other Applications & Softwares  > Outlook Formatting & Functions >  > [SOLVED] Need Excell Macro to send out all the emails from Outlook Drafts folder

## anto_01

Hi,

I have 100 emails in draft folder, i need a excell macro to send them out at the same using only one click.

Can you please share anybody the vba code to do this.

----------


## anto_01

Public Sub SendDrafts()

Dim lDraftItem As Long
Dim myOutlook As Outlook.Application
Dim myNameSpace As Outlook.NameSpace
Dim myFolders As Outlook.Folders
Dim myDraftsFolder As Outlook.MAPIFolder

'Send all items in the "Drafts" folder that have a "To" address filled in.

'Setup Outlook

Set myOutlook = Outlook.Application
Set myNameSpace = myOutlook.GetNamespace("MAPI")
Set myFolders = myNameSpace.Folders

'Set Draft Folder.

Set myDraftsFolder = myFolders("Mailbox" name).Folders("Drafts")

'Loop through all Draft Items

For lDraftItem = myDraftsFolder.Items.Count To 1 Step -1

'Check for "To" address and only send if "To" is filled in.

'If Len(Trim(myDraftsFolder.Items.Item(lDraftItem).To)) > 0 Then

'Send Item

myDraftsFolder.Items.Item(lDraftItem).Send


'End If
Next lDraftItem

'Clean-up

Set myDraftsFolder = Nothing
Set myNameSpace = Nothing
Set myOutlook = Nothing

End Sub

----------

