Sending emails using VBA without outlook

[Tej92]

Good morning, I've been trying to send automated emails depending on a cell value, I've succeeded with the use of outlook but the operator has to click allow every time because the company's Programmatic Access Settings don't allow outlook to send emails without confirmation, this confirmation has a few seconds of waiting time and delays the process.

I've now tried to do it without Outlook with the following code that i got online and adapted to my worksheet.

Private Sub CommandButton2_Click()
Dim Email_Text, Email_Configuration As Object
Dim Email_Subject, Email_Message, Email As String
Dim EmailFields As Variant
Set Email_Text = CreateObject("CDO.Message")
Set Email_Configuration = CreateObject("CDO.Configuration")
Email_Configuration.Load -1
Set EmailFields = Email_Configuration.fields
With EmailFields
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "my smtp server"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "My Username"
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "myPassword"
.Update
End With
With Sheet2
Email = "email@address.com"
Email_Subject = "task to do " + Range("C1")
Email_Message = "this is a test"
With Email_Text
Set .Configuration = Email_Configuration
.To = Email
.CC = ""
.BCC = ""
.From = " <>"
.Subject = Email_Subject
.TextBody = Email_Message
.Send
End With
Set Email_Text = Nothing
Set Email_Configuration = Nothing
Set EmailFields = Nothing
End With
MsgBox Count_Sent_Message & " Emails have been sent"
End Sub

Error:
Run-time error '-2147220975 (80040211)':
the message could not be sent to the SMTP server. the transport error code was 0x80040217. the server response was not available.
the SMTP address is definitely correct, so is the port.

the email will be sent by various users from their computer, having their credentials isn't an option. is there a way to send the email without a real email. It will not need to receive answers.
Does it need to have a real email address as sender?

 

[Tej92]

I've managed to sort the problem. just needed to remove the authentication lines.

Private Sub CommandButton2_Click()
Dim Email_Text, Email_Configuration As Object
Dim Email_Subject, Email_Message, Email As String
Dim EmailFields As Variant
Set Email_Text = CreateObject("CDO.Message")
Set Email_Configuration = CreateObject("CDO.Configuration")
Email_Configuration.Load -1
Set EmailFields = Email_Configuration.fields
With EmailFields
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "my smtp server"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
.Update
End With
With Sheet2
Email = "email@address.com"
Email_Subject = "task to do " + Range("C1")
Email_Message = "this is a test"
With Email_Text
Set .Configuration = Email_Configuration
.To = Email
.CC = ""
.BCC = ""
.From = " <email@address.com>"
.Subject = Email_Subject
.TextBody = Email_Message
.Send
End With
Set Email_Text = Nothing
Set Email_Configuration = Nothing
Set EmailFields = Nothing
End With
MsgBox Count_Sent_Message & " Emails have been sent"
End Sub