sending emails from drafts folder in outlook

ajm

Well-known Member
Joined
Feb 5, 2003
Messages
1,762
folks, i have a macro that creates a bunch of emails and stores them ready to send in a shared email account. once reviewed by my manager, they are to be sent out. I have been trying to find a macro that will enable these emails to be sent all at once from the shared account drafts folder. Can anyone help me out? I have found several macros to SendAllDraft emails but these require the Draft folder to be from the default email of the user. I have also found one that requires the mailbox name to be stated at the beginning. When using the shared account mailbox name in this one, the macro errors out with a run time error "-2147221233 (8004010f)': The attempted operation failed. An object could not be found." I guess this is because the specified shared mailbox does not sit on my hard drive. I am not allowed to send theses emails from my own email account and I don't want to manually have to open and send the three hundred emails waiting to go. Has anyone else managed to work around a situation like this?

Code:
Sub SendAllYourMailboxDrafts()
        SendAllDrafts "CHQ_Revenuereports@health.qld.gov.au"
    End Sub

    Sub SendAllDrafts(mailbox As String)

        Dim folder As MAPIFolder
        Dim msg As Outlook.MailItem
        Dim count As Integer

        Set folder = Outlook.GetNamespace("MAPI").Folders(mailbox)
        Set folder = folder.Folders("Drafts")

        If MsgBox("Are you sure you want to send the " & folder.Items.count & " items in your " & mailbox & " Drafts folder?", vbQuestion + vbYesNo) <> vbYes Then Exit Sub

        count = 0
        Do While folder.Items.count > 0
            Set msg = folder.Items(1)
            msg.Send
            count = count + 1
        Loop

        MsgBox count & " message(s) sent", vbInformation + vbOKOnly
    End Sub
 

Some videos you may like

Excel Facts

Did you know Excel offers Filter by Selection?
Add the AutoFilter icon to the Quick Access Toolbar. Select a cell containing Apple, click AutoFilter, and you will get all rows with Apple

John_w

MrExcel MVP
Joined
Oct 15, 2007
Messages
6,468
Untested. Try replacing:
Code:
        Set folder = Outlook.GetNamespace("MAPI").Folders(mailbox)
        Set folder = folder.Folders("Drafts")
with:
Code:
    Dim Ns As Outlook.NameSpace
    Dim ShareName As Outlook.Recipient

    Set Ns = Outlook.GetNamespace("MAPI")
    Set ShareName = Ns.CreateRecipient(mailbox)
    Set folder = Ns.GetSharedDefaultFolder(ShareName, olFolderDrafts)
 
  • Like
Reactions: ajm

ajm

Well-known Member
Joined
Feb 5, 2003
Messages
1,762
Untested. Try replacing:
Code:
        Set folder = Outlook.GetNamespace("MAPI").Folders(mailbox)
        Set folder = folder.Folders("Drafts")
with:
Code:
    Dim Ns As Outlook.NameSpace
    Dim ShareName As Outlook.Recipient

    Set Ns = Outlook.GetNamespace("MAPI")
    Set ShareName = Ns.CreateRecipient(mailbox)
    Set folder = Ns.GetSharedDefaultFolder(ShareName, olFolderDrafts)

awesome. Thanks John. You should put your rough whereabouts in your signature so, even though I am destined never to leave this country again (4 kids) soon, I can gauge the outside world through the good ol' mrexcel forum. thanks again.
 

Watch MrExcel Video

Forum statistics

Threads
1,114,443
Messages
5,547,955
Members
410,820
Latest member
Prepost
Top