VBA for sending all emails in outlook draft folder

[Moustafa Houssien]

Hi,
I need support for knowing the problem in the below code as the error message "Run-Time Error '13':type mismatched" appeared

Sub SendAllDraftEmails()

'Declare variables
Dim objOutlook As Outlook.Application
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

 

[Skyybot]

Which line does the error occur?

 

[Moustafa Houssien]

Which line does the error occur?

the below line

Set objOutlook = Application

 

[Skyybot]

Try this

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

 

[Moustafa Houssien]

Try this

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

Thanks it works but stopped in the below line
Set objFolder = objOutlook.GetNamespace("MAPI").GetDefaultFolder(olFolderDrafts)

Run-time error '438' :Object doesn't support this property or method

Thanks for your support

 

[Moustafa Houssien]

Sorry I forget to inform you that the draft folder in PST file named Mail 2023

 

[Skyybot]

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

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

 

[Skyybot]

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

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

Nevermind. It doesn't work.

 

[Moustafa Houssien]

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

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

Thanks I will try it