How to generate email draft to a shared mailbox's Drafts folder?

[michfung95]

Hi,

The following codes are created to generate emails to a shared mailbox "abc@de.com" draft mailbox. However, at step "Set OutlookDestFolder = OutlookNS.Folders("abc@de.com").Folders("Drafts")", I receive the error message "run-time error '-2147221233 (8004010f)': The attempted operation failed. An object could not be found." May I know what is the solution?

Sub Send_Emails()
'This code is early binding i.e in Tools >
'Reference >You have check "MICROSOFT OUTLOOK 14.0 OBJECT LIBRARY"

'Check attachment
Dim Last_Row As Long
Last_Row = Sheets("Email").Range("A" & Rows.Count).End(xlUp).Row

For i = 2 To Last_Row
Dim sFile As String
sFile = ThisWorkbook.Worksheets("Email").Cells(i, 11)
If Len(Dir(sFile, vbDirectory)) = 0 Then
MsgBox "Please check attachment!!"
Exit Sub
End If
Next

'Send email

For i = 2 To Last_Row

If Cells(i, 12).Value = "" Then

Dim OutlookApp As Outlook.Application
Dim OutlookMail As Outlook.MailItem
Dim OutlookAccount As Outlook.Account
Dim OutlookDestFolder As Outlook.MAPIFolder
Dim OutlookNamespace As Outlook.Namespace
Dim StrBody As String

Set OutlookApp = New Outlook.Application
Set OutlookMail = OutlookApp.CreateItem(olMailItem)
Set OutlookAccount = OutlookApp.session.Accounts("abc@de.com")
Set OutlookNS = OutlookApp.GetNamespace("MAPI")


OutlookMail.SentOnBehalfOfName = "abc@de.com"


source_file = Cells(i, 11)

StrBody = Sheets("Email").Cells(i, 10).Value & "<br><br>" & _
Sheets("Email").Cells(i, 17).Value & "<br><br>" & _
Sheets("Email").Cells(i, 13).Value & "<br>" & _
Sheets("Email").Cells(i, 14).Value & "<br>" & _
Sheets("Email").Cells(i, 15).Value & "<br>" & _
Sheets("Email").Cells(i, 16).Value & "<br><br>" & _
Sheets("Email").Cells(i, 18).Value & "<br><br>" & _
"1) Confirm the " & "<b><span style='color: blue;'>" & "client code, job code, and amount" & "</span></b>" & "with which the IT invoice will be charged" & "<br><br>" & _
Sheets("Email").Cells(i, 20).Value & "<br><br>" & _
"3) Provide the " & "<b><span style='color: blue;'>" & "client invoice(s) # (HKGxxxxxxxx)" & "</span></b>" & ", if there is one or there will be one, which accrues for or covers this IT invoice." & "<br><br>" & _
Sheets("Email").Cells(i, 22).Value & "<br><br>" & _
"<b><span style='color: red;'>" & Sheets("Email").Cells(i, 23).Value & "</span></b>" & "<br>" & _
"<b><span style='color: red;'>" & Sheets("Email").Cells(i, 24).Value & "</span></b>" & "<br><br>" & _
Sheets("Email").Cells(i, 3).Value & "<br><br>" & _
Sheets("Email").Cells(i, 4).Value & "<br>" & _
Sheets("Email").Cells(i, 5).Value & "<br>" & _
Sheets("Email").Cells(i, 6).Value & "<br>" & _
Sheets("Email").Cells(i, 7).Value & "<br>" & _
Sheets("Email").Cells(i, 8).Value & "<br>"

With OutlookMail
.BodyFormat = olFormatHTML
.Display
.HTMLBody = StrBody

.To = Sheets("Email").Cells(i, 1)
.CC = Sheets("Email").Cells(i, 2)
'.BCC = "hello@gamil.com;hi@gmail.com"
.Subject = Cells(i, 9)
.Attachments.Add source_file
.Close (olSave) '<--if want to send directly without check, change to .Send



End With

Set OutlookDestFolder = OutlookNS.Folders("abc@de.com").Folders("Drafts")
OutlookMail.Move OutlookDestFolder
End If

Cells(i, 12) = "Sent"

Next

End Sub