VBA code will not send emails from Draft Folder (326 emails)

[bean0016]

Hi I used code from the techrepublic.com, "send-all-mails-from-my-drafts-folder-at-one-go-in-outlook-2003"and I keep getting an error on the line "myDraftsFolder.Items.Item(lDraftItem).Send". When I ran the macro it will send about 40 of the emails, but then stop and I get the error, "Outlook does not recognize one or more names". I have no idea why it sent some emails and then just stopped. It worked on my computer, but when I placed this code on a co-workers computer that is where the errors are coming from. Any ideas.



Public Sub SendDrafts()

Dim lDraftItem As Long
Dim myOutlook As Outlook.Application
Dim myNameSpace As Outlook.NameSpace
Dim myFolders As Outlook.Folders
Dim myDraftsFolder As Outlook.MAPIFolder

'Send all items in the "Drafts" folder that have a "To" address filled in.

'Setup Outlook

Set myOutlook = Outlook.Application
Set myNameSpace = myOutlook.GetNamespace("MAPI")
Set myFolders = myNameSpace.Folders

'Set Draft Folder. This will need modification based on where it's being run.

Set myDraftsFolder = myNameSpace.GetDefaultFolder(olFolderDrafts)

'Loop through all Draft Items

For lDraftItem = myDraftsFolder.Items.Count To 1 Step -1

'Check for "To" address and only send if "To" is filled in.

If Len(myDraftsFolder.Items.Item(lDraftItem).To) > 0 Then

'Send Item

myDraftsFolder.Items.Item(lDraftItem).Send

End If
Next lDraftItem

'Clean-up

Set myDraftsFolder = Nothing
Set myNameSpace = Nothing
Set myOutlook = Nothing

End Sub



Thank you!
:banghead:

[DazLocker]

Hi,

Try This

Public Sub SendDrafts()

Dim lDraftItem As Long
Dim myOutlook As Outlook.Application
Dim myNameSpace As Outlook.NameSpace
Dim myFolders As Outlook.Folders
Dim myDraftsFolder As Outlook.MAPIFolder

'Send all items in the "Drafts" folder that have a "To" address filled in.

'Setup Outlook
Set myOutlook = Outlook.Application
Set myNameSpace = myOutlook.GetNamespace("MAPI")
Set myFolders = myNameSpace.Folders

'Set Draft Folder.
Set myDraftsFolder = myFolders("Mailbox - Your Name").Folders("Drafts")

'Loop through all Draft Items
For lDraftItem = myDraftsFolder.Items.Count To 1 Step -1

'Check for "To" address and only send if "To" is filled in.
If Len(Trim(myDraftsFolder.Items.Item(lDraftItem).To)) > 0 Then

'Send Item
myDraftsFolder.Items.Item(lDraftItem).Send

End If

Next lDraftItem

'Clean-up
Set myDraftsFolder = Nothing
Set myNameSpace = Nothing
Set myOutlook = Nothing

End Sub


Regards.

Daz

[DazLocker]

Hi,

Try This

Public Sub SendDrafts()

Dim lDraftItem As Long
Dim myOutlook As Outlook.Application
Dim myNameSpace As Outlook.NameSpace
Dim myFolders As Outlook.Folders
Dim myDraftsFolder As Outlook.MAPIFolder

'Send all items in the "Drafts" folder that have a "To" address filled in.

'Setup Outlook
Set myOutlook = Outlook.Application
Set myNameSpace = myOutlook.GetNamespace("MAPI")
Set myFolders = myNameSpace.Folders

'Set Draft Folder.
Set myDraftsFolder = myFolders("Mailbox - Your Name").Folders("Drafts")

'Loop through all Draft Items
For lDraftItem = myDraftsFolder.Items.Count To 1 Step -1

'Check for "To" address and only send if "To" is filled in.
If Len(Trim(myDraftsFolder.Items.Item(lDraftItem).To)) > 0 Then

'Send Item
myDraftsFolder.Items.Item(lDraftItem).Send

End If

Next lDraftItem

'Clean-up
Set myDraftsFolder = Nothing
Set myNameSpace = Nothing
Set myOutlook = Nothing

End Sub


Regards.

Daz