I need to periodically send e-mails and I used the following code for years:
Function SSLSendMail(sTO As String, sFROM As String, sSubject As String, sText As String, sServer As String, _
sUser As String, sPassword As String, Optional sAttach As String, Optional sCC As String, Optional sBCC As String) As Boolean
Dim ObjSendMail As Object
Set ObjSendMail = CreateObject("CDO.Message")
Dim iConf As Object
Set iConf = CreateObject("CDO.Configuration")
With iConf.Fields 'Flds
.Item(cdoSendUsingMethod) = cdoSendUsingPort ' 2
.Item(cdoSMTPAuthenticate) = cdoBasic ' 1
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True ' If use SSL set to True, if not, set to False
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
.Item(cdoSendUserName) = sUser
.Item(cdoSendPassword) = sPassword
.Item(cdoSMTPServer) = sServer
.Item(cdoSMTPConnectionTimeout) = 10
.Update
End With
Set ObjSendMail.Configuration = iConf
With ObjSendMail
.To = sTO
.Subject = sSubject
.from = sFROM
.TextBody = sText
If sAttach > "" Then
.AddAttachment sAttach
End If
If sCC > "" Then
.cc = sCC
End If
If sBCC > "" Then
.BCC = sBCC
End If
On Local Error GoTo invalidTo
.Send
On Local Error GoTo 0
End With
Set ObjSendMail = Nothing
Set iConf = Nothing
SSLSendMail = True
Exit Function
invalidTo:
Debug.Print "Error on " & sTO & ": " & Err.description
Err.Clear
SSLSendMail = False
End Function
In the last days, I get error 0x80040217 and the mail is not sent. After some investigation, I found that Google changed the authentication method from Basic to OAuth2 or, at least, that is what I have to change in my Thunderbird client in order to be able to send mails. I have seen an answer to a similar question suggesting to use Outlook object, but that is not applicable for a series of reasons: I don't have any outlook user configured (and I don't want to!), the "sender" seems not dynamically specified, etc. I guess I have to change .Item(cdoSMTPAuthenticate) = cdoBasic to something else, but I cannot find anything related to OAuth2.
After days and days of unsuccessfully testing changes in that code, I finally realized the problem was in the SMTP server only. I had to access my Google configuration page, ask for a second level security for the specific machine on which the Excel VBA is running and I got an encrypted password, based on my regular password, I guess. Using that password, the above code works fine, as before. Thanks Google for making our life more difficult!