Sending gmail email through Excel (VBA)

[RawlinsCross]

I found a code snippit that should allow me to send an gmail email but I'm getting an error - is there anyone who has experience with this? I'm getting the "-2147220975 'Incorrect credentials User ID or password" even though I've checked both many times already.

'For Early Binding, enable Tools > References > Microsoft CDO for Windows 2000 Library
Public Sub SendEmailUsingGmail(sSubject As String, sRecipients As String, sDetails As String)

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 = "*************"  'normally my email account
    .To = sRecipients
    .CC = ""
    .BCC = ""
    .Subject = sSubject
    .Textbody = sDetails
    '.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") = "************" 'Your gmail address
    .Item(msConfigURL & "/sendpassword") = "*********" '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 '<- I'm getting to this error
    Case Else   'Report other errors
        MsgBox "Error encountered while sending email." & vbNewLine & Err.Number & ": " & Err.Description
    End Select

    Resume Exit_Err

End Sub

 

[Kerryx]

Have you set up the app password in the google account as you use that password now rather than the account password. The option to allow less secure apps has been discontinued since May 2022.

 

[RawlinsCross]

Yes, I've figured that out after researching it more - so you're spot on there!

Found some useful info there under "Step 1"

How to Send Emails From an Excel Spreadsheet Using VBA Scripts

Our code template will help you set up automated emails from within Excel using Collaboration Data Objects (CDO) and VBA scripts.

www.makeuseof.com

 

[JCCinOhio]

Yes, I've figured that out after researching it more - so you're spot on there!

Found some useful info there under "Step 1"

How to Send Emails From an Excel Spreadsheet Using VBA Scripts

Our code template will help you set up automated emails from within Excel using Collaboration Data Objects (CDO) and VBA scripts.

www.makeuseof.com

Were you able to get this to work? Mine was working in 2021, but gmail made it so you couldn't enable less secure apps and that killed mine. Looking for a new solution.

 

[Kerryx]

Gmail app setup

 

[JCCinOhio]

Yep, thanks. I gave it a try yesterday and it worked fine.

 

[kavemankev]

I found a code snippit that should allow me to send an gmail email but I'm getting an error - is there anyone who has experience with this? I'm getting the "-2147220975 'Incorrect credentials User ID or password" even though I've checked both many times already.

'For Early Binding, enable Tools > References > Microsoft CDO for Windows 2000 Library
Public Sub SendEmailUsingGmail(sSubject As String, sRecipients As String, sDetails As String)

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 = "*************"  'normally my email account
    .To = sRecipients
    .CC = ""
    .BCC = ""
    .Subject = sSubject
    .Textbody = sDetails
    '.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") = "************" 'Your gmail address
    .Item(msConfigURL & "/sendpassword") = "*********" '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 '<- I'm getting to this error
    Case Else   'Report other errors
        MsgBox "Error encountered while sending email." & vbNewLine & Err.Number & ": " & Err.Description
    End Select

    Resume Exit_Err

End Sub

I had to change:
'late binding
Set NewMail = CreateObject("CDO.Message")
Set mailConfig = CreateObject("CDO.Configuration")

to:
Set NewMail = New CDO.Message
Set mailconfig = New CDO.Configuration

and it worked.