Avatar of Nirvana
Nirvana
Flag for India asked on

send bulk mails from drafts folder

Send bulk mails from drafts;

I am using the below code  to send mails from drafts folder. however, they are getting deleted,

https://www.extendoffice.com/documents/outlook/5064-outlook-send-multiple-drafts-at-once.html


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 " 
    End If
Else
    MsgBox "No Drafts!", vbInformation + vbOKOnly
End If
End Sub
OutlookVBA

Avatar of undefined
Last Comment
Bill Prew

8/22/2022 - Mon
Kimputer

remove this line if you want to keep it in the Drafts folder:
xDraftsItems.Item(i).Delete

Open in new window


Nirvana

ASKER
Thank you, but everything is going to deleted folder. is there any other solution?
Kimputer

No, if you REMOVE that line, it should STAY in the Drafs folder.
All of life is about relationships, and EE has made a viirtual community a real community. It lifts everyone's boat
William Peck
Bill Prew

Just passing by, but normally when you compose an email it resides in the Drafts folder, and then when you send it it gets moved fist to the Outgoing folder, and then when transmission is complete to the Sent Items folder.  Have you checked there for it?


»bp
Nirvana

ASKER
Hi Bill,

As soon I run the macro, it says "Successfully sent" but directly goes and sits in deleted folder. these email messages are copied to "drafts folder" from local drive. not composed and which got saved to Drafts

Stay safe. Be healthy!!
ASKER CERTIFIED SOLUTION
Bill Prew

Log in or sign up to see answer
Become an EE member today7-DAY FREE TRIAL
Members can start a 7-Day Free trial then enjoy unlimited access to the platform
Sign up - Free for 7 days
or
Learn why we charge membership fees
We get it - no one likes a content blocker. Take one extra minute and find out why we block content.
Not exactly the question you had in mind?
Sign up for an EE membership and get your own personalized solution. With an EE membership, you can ask unlimited troubleshooting, research, or opinion questions.
ask a question