Sending Email

RLPeloquin

Board Regular
Joined
Jul 4, 2020
Messages
73
Office Version
  1. 2019
Platform
  1. Windows
Can anyone please help me figure out what's wrong with this code. I have a command button with this code in a module. I've did the "Less Secure App" on my email security.
Sub Send_Email()
Dim CDO_Mail As Object
Dim CDO_Config As Object
Dim SMTP_Config As Variant
Dim strSubject As String
Dim strFrom As String
Dim strTo As String
Dim strCc As String
Dim strBcc As String
Dim strBody As String
strSubject = "Electricity Usage"
strFrom = "rlp4588@gmail.com"
strTo = "rlp4588@gmail.com"
strCc = ""
strBcc = ""
'strBody = "Current Charges: " & Str(Sheet1.Cells(2, 1))


Set CDO_Mail = CreateObject("CDO.Message")
On Error GoTo error_handling
Set CDO_Config = CreateObject("CDO.Configuration")
CDO_Config.Load -1
Set SMTP_Config = CDO_Config.Fields
With SMTP_Config
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessel") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "rlp4588@gmail.com"
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "xxxxxxxx" 'Not actual password
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 587
.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
.Update
End With
With CDO_Mail
Set .Configuration = CDO_Config
End With

CDO_Mail.Subject = strSubject
CDO_Mail.From = strFrom
CDO_Mail.To = strTo
CDO_Mail.TextBody = strBody
CDO_Mail.CC = strCc
CDO_Mail.BCC = strBcc
CDO_Mail.Send
error_handling:
If Err.Description <> "" Then MsgBox Err.Description



End Sub
 

Excel Facts

Which came first: VisiCalc or Lotus 1-2-3?
Dan Bricklin and Bob Frankston debuted VisiCalc in 1979 as a Visible Calculator. Lotus 1-2-3 debuted in the early 1980's, from Mitch Kapor.
First:
From the Tools menu, choose References to display the References dialog box.
In the References dialog box mark reference “Microsoft CDO for Windows 2000 Library”:
Image showing how to add the Microsoft CDO Library to the Office VBA Environment


Try this:

VBA Code:
Sub Enviar_Correos_Gmail()
  Dim CDO_Mail As Object
  Dim strFrom As String, passwd As String, strTo As String
  Dim strSubject As String, strCc As String, strBcc As String, strBody As String
  
  strFrom = "rlp4588@gmail.com"           'email gmail
  passwd = "pwd"                          'password
  strTo = "rlp4588@gmail.com"
  strSubject = "Electricity Usage"
  strCc = ""
  strBcc = ""
  'strBody = "Current Charges: " & Str(Sheet1.Cells(2, 1))
  
  Set CDO_Mail = CreateObject("CDO.Message")
  CDO_Mail.Configuration.Fields(cdoSMTPServer) = "smtp.gmail.com"
  CDO_Mail.Configuration.Fields(cdoSendUsingMethod) = 2
  With CDO_Mail.Configuration.Fields
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = CLng(465)
    .Item("http://schemas.microsoft.com/cdo/" & "configuration/smtpauthenticate") = Abs(1)
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 30
    .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = strFrom
    .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = passwd
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
  End With
  With CDO_Mail
    .From = strFrom
    .To = strTo
    .cc = strCc
    .bcc = strBcc
    .Subject = strSubject
    .TextBody = strBody
    .Configuration.Fields.Update
    On Error Resume Next
    .Send
  End With
  If Err.Number = 0 Then
    MsgBox "Sent email"
  Else
    MsgBox "Error: " & Err.Number & " " & Err.Description
  End If
  Set CDO_Mail = Nothing
End Sub
 
Upvote 0

Forum statistics

Threads
1,213,489
Messages
6,113,952
Members
448,535
Latest member
alrossman

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top