sending emails from drafts folder in outlook

[ajm]

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?

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

 

[John_w]

Untested. Try replacing:

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

with:

    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)

 

[ajm]

Untested. Try replacing:

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

with:

    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.