VBA for sending all emails in outlook draft folder

Skyybot said:

Which line does the error occur?

Click to expand...

Skyybot said:

Try this

VBA Code:

Sub SendAllDraftEmails()

'Declare variables
'Dim objOutlook As Outlook.Application
Dim ol As Object
Dim objOutook As Application
Set ol = CreateObject("Outlook.Application")
Set objOutlook = ol

Dim objFolder As Outlook.MAPIFolder
Dim objMail As Outlook.MailItem
Dim lCounter As Long

'Get the Outlook application object
Set objOutlook = Application

'Get the draft folder
Set objFolder = objOutlook.GetNamespace("MAPI").GetDefaultFolder(olFolderDrafts)

'Initialize the counter
lCounter = 1

'Loop through all the items in the draft folder
For Each objMail In objFolder.Items

'Send the email
objMail.Send

'Increment the counter
lCounter = lCounter + 1

Next objMail

'Display a message box
MsgBox "Sent " & lCounter & " emails"

End Sub

Click to expand...

Skyybot said:

See if this works. Apologies for the uncertainty, but I normally don't call other Office Applications in my Excel VBA.

VBA Code:

Sub SendAllDraftEmails()

'Declare variables
'Dim objOutlook As Outlook.Application
'Dim ol As Object
'Dim objOutook As Application
'Set ol = CreateObject("Outlook.Application")
'Set objOutlook = ol

Dim objFolder As Outlook.MAPIFolder
Dim objMail As Outlook.MailItem
Dim lCounter As Long

'Get the Outlook application object
'Set objOutlook = Application

SHELL ("Outlook")

'Get the draft folder
Set objFolder = objOutlook.GetNamespace("MAPI").GetDefaultFolder(olFolderDrafts)

'Initialize the counter
lCounter = 1

'Loop through all the items in the draft folder
For Each objMail In objFolder.Items

'Send the email
objMail.Send

'Increment the counter
lCounter = lCounter + 1

Next objMail

'Display a message box
MsgBox "Sent " & lCounter & " emails"

End Sub

Click to expand...

Skyybot said:

See if this works. Apologies for the uncertainty, but I normally don't call other Office Applications in my Excel VBA.

VBA Code:

Sub SendAllDraftEmails()

'Declare variables
'Dim objOutlook As Outlook.Application
'Dim ol As Object
'Dim objOutook As Application
'Set ol = CreateObject("Outlook.Application")
'Set objOutlook = ol

Dim objFolder As Outlook.MAPIFolder
Dim objMail As Outlook.MailItem
Dim lCounter As Long

'Get the Outlook application object
'Set objOutlook = Application

SHELL ("Outlook")

'Get the draft folder
Set objFolder = objOutlook.GetNamespace("MAPI").GetDefaultFolder(olFolderDrafts)

'Initialize the counter
lCounter = 1

'Loop through all the items in the draft folder
For Each objMail In objFolder.Items

'Send the email
objMail.Send

'Increment the counter
lCounter = lCounter + 1

Next objMail

'Display a message box
MsgBox "Sent " & lCounter & " emails"

End Sub

Click to expand...