Email with VBA without outlook

[Shloime]

I have the following code it does not work how can i get it work for using to send from a gmail

'Build the text for the body of the message (could be read from ranges in Excel)
    mlText = "Thanks for buying from us" & vbNewLine &  _
                    "Please find you invoice attached."
   On Error GoTo Err:

   'early binding
   'Set NewMail = New CDO.Message
   'Set mailConfig = New CDO.Configuration
  
    Set NewMail = CreateObject("CDO.Message")
    Set mailConfig = NewMail.Configuration
   'load all default configurations
   mailConfig.Load -1
    EML = "**************@gmail.com"
    PAS = "Password"
   Set fields = mailConfig.fields
  
   'Set All Email Properties
   With NewMail
       .From = EML
       .To = "hellomyfriend@gmail.com"
       .cc = ""
       .BCC = ""
       .Subject = "Ithe subject"
       .TextBody = mlText ' & Str(Sheet1.Cells(2, 1))
       .Addattachment "c:\data\email.xlsx" 'Optional file attachment; remove if not needed.
       '.Addattachment "c:\data\email.pdf" 'Duplicate the line for a second attachment.
   End With

   msConfigURL = "http://schemas.microsoft.com/cdo/configuration"

   With fields
       .Item(msConfigURL & "/smtpusessl") = True 'Enable SSL Authentication
       .Item(msConfigURL & "/smtpauthenticate") = 1 'SMTP authentication Enabled
       .Item(msConfigURL & "/smtpserver") = "smtp.gmail.com" 'Set the SMTP server details
       .Item(msConfigURL & "/smtpserverport") = 465 'Set the SMTP port Details
       .Item(msConfigURL & "/sendusing") = 2 'Send using default setting
       .Item(msConfigURL & "/sendusername") = EML 'Your gmail address
       .Item(msConfigURL & "/sendpassword") = PAS '"fprmkutzyopfalft" 'Your password or App Password"
       .Update 'Update the configuration fields
   End With
   NewMail.Configuration = mailConfig
   NewMail.Send
 
   MsgBox "Your email has been sent", vbInformation

Exit_Err:
   'Release object memory
   Set NewMail = Nothing
   Set mailConfig = Nothing
   End

Err:
   Select Case Err.Number
   Case -2147220973 'Could be because of Internet Connection
       MsgBox "Check your internet connection." & vbNewLine & Err.Number & ": " & Err.Description
   Case -2147220975 'Incorrect credentials User ID or password
       MsgBox "Check your login credentials and try again." & vbNewLine & Err.Number & ": " & Err.Description
   Case Else 'Report other errors
       MsgBox "Error encountered while sending email." & vbNewLine & Err.Number & ": " & Err.Description
   End Select

 

[RoryA]

Please elaborate on "does not work". What happens?

 

[Logit]

The following has worked for me in the past :

Option Explicit

'For Early Binding, enable Tools > References > Microsoft CDO for Windows 2000 Library
Sub SendEmailUsingGmail()
    Dim NewMail As Object
    Dim mailConfig As Object
    Dim fields As Variant
    Dim msConfigURL As String
    On Error GoTo Err:

    'late binding
    Set NewMail = CreateObject("CDO.Message")
    Set mailConfig = CreateObject("CDO.Configuration")

    ' load all default configurations
    mailConfig.Load -1

    Set fields = mailConfig.fields

    'Set All Email Properties
    With NewMail
        .From = "youremail@gmail.com"
        .To = "recipient@domain.com"
        .CC = ""
        .BCC = ""
        .Subject = "Demo Spreadsheet Attached"
        .Textbody = "Let me know if you have questions about the attached spreadsheet!"
        '.Addattachment "c:\data\testmail.xlsx"
    End With

    msConfigURL = "http://schemas.microsoft.com/cdo/configuration"

    With fields
        .Item(msConfigURL & "/smtpusessl") = True             'Enable SSL Authentication
        .Item(msConfigURL & "/smtpauthenticate") = 1          'SMTP authentication Enabled
        .Item(msConfigURL & "/smtpserver") = "smtp.gmail.com" 'Set the SMTP server details
        .Item(msConfigURL & "/smtpserverport") = 465          'Set the SMTP port Details
        .Item(msConfigURL & "/sendusing") = 2                 'Send using default setting
        .Item(msConfigURL & "/sendusername") = "youremail@gmail.com" 'Your gmail address
        .Item(msConfigURL & "/sendpassword") = "yourpassword" 'Your password or App Password
        .Update                                               'Update the configuration fields
    End With
    NewMail.Configuration = mailConfig
    NewMail.Send
    
    MsgBox "Your email has been sent", vbInformation

Exit_Err:
    'Release object memory
    Set NewMail = Nothing
    Set mailConfig = Nothing
    End

Err:
    Select Case Err.Number
    Case -2147220973  'Could be because of Internet Connection
        MsgBox "Check your internet connection." & vbNewLine & Err.Number & ": " & Err.Description
    Case -2147220975  'Incorrect credentials User ID or password
        MsgBox "Check your login credentials and try again." & vbNewLine & Err.Number & ": " & Err.Description
    Case Else   'Report other errors
        MsgBox "Error encountered while sending email." & vbNewLine & Err.Number & ": " & Err.Description
    End Select

    Resume Exit_Err

End Sub

 

[Shloime]

The following has worked for me in the past :

Option Explicit

'For Early Binding, enable Tools > References > Microsoft CDO for Windows 2000 Library
Sub SendEmailUsingGmail()
    Dim NewMail As Object
    Dim mailConfig As Object
    Dim fields As Variant
    Dim msConfigURL As String
    On Error GoTo Err:

    'late binding
    Set NewMail = CreateObject("CDO.Message")
    Set mailConfig = CreateObject("CDO.Configuration")

    ' load all default configurations
    mailConfig.Load -1

    Set fields = mailConfig.fields

    'Set All Email Properties
    With NewMail
        .From = "youremail@gmail.com"
        .To = "recipient@domain.com"
        .CC = ""
        .BCC = ""
        .Subject = "Demo Spreadsheet Attached"
        .Textbody = "Let me know if you have questions about the attached spreadsheet!"
        '.Addattachment "c:\data\testmail.xlsx"
    End With

    msConfigURL = "http://schemas.microsoft.com/cdo/configuration"

    With fields
        .Item(msConfigURL & "/smtpusessl") = True             'Enable SSL Authentication
        .Item(msConfigURL & "/smtpauthenticate") = 1          'SMTP authentication Enabled
        .Item(msConfigURL & "/smtpserver") = "smtp.gmail.com" 'Set the SMTP server details
        .Item(msConfigURL & "/smtpserverport") = 465          'Set the SMTP port Details
        .Item(msConfigURL & "/sendusing") = 2                 'Send using default setting
        .Item(msConfigURL & "/sendusername") = "youremail@gmail.com" 'Your gmail address
        .Item(msConfigURL & "/sendpassword") = "yourpassword" 'Your password or App Password
        .Update                                               'Update the configuration fields
    End With
    NewMail.Configuration = mailConfig
    NewMail.Send
   
    MsgBox "Your email has been sent", vbInformation

Exit_Err:
    'Release object memory
    Set NewMail = Nothing
    Set mailConfig = Nothing
    End

Err:
    Select Case Err.Number
    Case -2147220973  'Could be because of Internet Connection
        MsgBox "Check your internet connection." & vbNewLine & Err.Number & ": " & Err.Description
    Case -2147220975  'Incorrect credentials User ID or password
        MsgBox "Check your login credentials and try again." & vbNewLine & Err.Number & ": " & Err.Description
    Case Else   'Report other errors
        MsgBox "Error encountered while sending email." & vbNewLine & Err.Number & ": " & Err.Description
    End Select

    Resume Exit_Err

End Sub

Check your loin /credential and try again.
-2147220975: The message could not be sent to the smptp server. The transport code was 0x80040217. The server reponse was not available

 

[Shloime]

Check your loin /credential and try again.
-2147220975: The message could not be sent to the smptp server. The transport code was 0x80040217. The server reponse was not available

I tried the code with another email not gmail and it worked so it's probably some setting in gmail to change