I have a list of email ids in Excel and I have a number of drafts stored.
I am trying to send particular drafts to the list of email ids based on the subject line of the drafts.
There is an error on the line .copy
and .send
when I have multiple drafts present but not when only one draft is present.
Sub eng()
Dim lDraftItem, myOutlook, myNameSpace, myFolders, myDraftsFolder
Set myOutlook = CreateObject("Outlook.Application")
Set myNameSpace = myOutlook.GetNamespace("MAPI")
myNameSpace.Logon "Outlook"
Set myFolders = myNameSpace.Folders
Set myDraftsFolder = myFolders("[email protected]").Folders("Drafts")
For lDraftItem = myDraftsFolder.Items.Count To 1 Step -1
If InStr(myDraftsFolder.Items.item(lDraftItem).subject, "Subjectline") <> 0 Then
For i = 2 To iTotalRows
myDraftsFolder.Items.item(lDraftItem).Copy
myDraftsFolder.Items.item(lDraftItem).SentOnBehalfOfName = "email"
myDraftsFolder.Items.item(lDraftItem).To = "email"
myDraftsFolder.Items.item(lDraftItem).Send
Next
End If
Next lDraftItem
Set myDraftsFolder = Nothing
Set myNameSpace = Nothing
Set myOutlook = Nothing
End Sub
This is multiple dot notation taken to an extreme. Secondly, MailItem.Copy returns the newly created (copied) item. You are ignoring the returned value. Did you mean the following?
set items = myDraftsFolder.Items
For lDraftItem = items.Count To 1 Step -1
set item = items.Item(lDraftItem)
If InStr(item.subject, "Subjectline") <> 0 Then
For i = 2 To iTotalRows
set newItem = item.Copy
newItem.SentOnBehalfOfName = "email"
newItem.To = "email"
newItem.Send
Next
End If
Next lDraftItem