Hello,

The code below used to work flawlessly when sending email reminders. However, I recently added 2-step verification on my gmail account for
extra security and now I am getting the error below. Is their a work around?

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

Private Sub Workbook_Open()
    Dim iMsg As Object
    Dim iConf As Object
    Dim strbody As String
    Dim Flds As Variant

    Set iMsg = CreateObject("CDO.Message")
    Set iConf = CreateObject("CDO.Configuration")
           
    iConf.Load -1
    Set Flds = iConf.Fields
    With Flds
        .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") = "email@gmail.com"
        .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "password"
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
        .Update
    End With

    strbody = "Pay Sprint"

    With iMsg
        Set .Configuration = iConf
        .to = "email@gmail.com"
        .CC = ""
        .BCC = ""
        .From = " <email@gmail.com>"
        .Subject = "REMINDER"
        .TextBody = strbody
        .Send
    End With
        
End Sub