Sending Email Drafts from secondary outlook email account

[JustMat82]

Hi,

New forum member here, I stumbled across this great forum when I was looking for a resolutionto my current issue,I’m hoping I’msimply missing a line or two of code.
I have two modules; it’s the second one that I’m having theissue with

1. Creates the email, with To, CC, content, attachment etc… using my secondary email account (which is ashared team mailbox)
2. takes the email drafts and sends them.

The script I am using for module 2 is below, the problem I am having is that when it istrying to send the drafts, it is referencing my primary email account not mysecondary one (Session.Accounts.Item(2)) and therefore cannot find the draftsas they are in the secondary email addresses draft folder.
I’m hoping its something simple, any help would beappreciated, I know I could remove the saveas drafts element and send straight from the creation, but I’d like to give theend user the opportunity to review the emails before sending in bulk.
Any help would be greatly appreciated.
Thanks
Mat

Sub SendAllDraftEmails()
Dim objDrafts AsOutlook.Items
Dim objDraft AsObject
Dim strPrompt AsString
Dim nResponse AsInteger
Dim I As Long
Dim merror AsInteger, Gcount As Integer
On Error GoToerr_handle
Set objDrafts =Outlook.Application.Session.GetDefaultFolder(olFolderDrafts).Items
Gcount =objDrafts.Count
If objDrafts.Count> 0 Then
strPrompt ="Are you sure you want to send out all the drafts? ANYTHING ELSE IN YOURDRAFTS FOLDER WILL ALSO BE SENT!!"
nResponse =MsgBox(strPrompt, vbQuestion + vbYesNo, "Confirm Sending")
If nResponse =vbYes Then
For I =objDrafts.Count To 1 Step -1
Next
End If

If merror > 0And merror = Gcount Then
MsgBox"No Draft Emails Sent!", vbCritical, "Email SendingErrors!"
ElseIf merror> 0 And merror < Gcount Then
MsgBox"Some Draft Emails were sent - " & Trim(Str(merror)) & "emails were not sent", vbCritical, "Email Sending Errors!"
Else
MsgBox"All Draft Emails Sent!", vbInformation, "Email Sending"

End If

Else
MsgBox "NoDraft Emails Found!", vbExclamation, "No Draft Emails Found"
End If
Exit Sub
err_handle:
If Err ="-2147467259" Then
MsgBox"There must be at least one email address or contact group in the TO, CCor BCC fields" & vbCrLf & "Fix it and re-run youremails", vbExclamation, "Error in Email Address!"
merror = 1 +merror
Resume Next
End If
End Sub

[JustMat82]

managed to sort with a piece of script including the below (if anyone wants to use it)

Set Ns = Outlook.GetNamespace("MAPI")
Set ShareName = Ns.CreateRecipient(mailbox)

Dim fldDraft As MAPIFolder, msg As Outlook.MailItem, intCount As Integer
Set fldDraft = Ns.GetSharedDefaultFolder(ShareName, olFolderDrafts)

Set folder = Ns.GetSharedDefaultFolder(ShareName, olFolderDrafts)