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

michfung95

New Member
Joined
Apr 27, 2021
Messages
2
Office Version
  1. 365
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
 

Excel Facts

Show numbers in thousands?
Use a custom number format of #,##0,K. Each comma after the final 0 will divide the displayed number by another thousand

Forum statistics

Threads
1,213,511
Messages
6,114,054
Members
448,543
Latest member
MartinLarkin

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top