Send mail via CDO doesn't work in windows 10

when I do a debug I see that all mMessage fields are empty.

I guess this is related to https://support.microsoft.com/en-us/help/2028411/collaboration-data-objects-cdo-1-2-1-is-not-supported-with-outlook-201

 

What can I do?

Please help

 

The code I use:

Function SendEmail_Gmail(mFrom, mTo, mSubject, mBody, mAttachment,mpath)
Dim smtpServer, smtpPort, userLogin, userPassword
Dim authenticationType, useSSL, connectionTimeout
Dim schema, mConfig, mMessage
mFrom="testcomp.unisfair@gmail.com"

smtpServer = "smtp.gmail.com"
smtpPort = 25
userLogin = "myaccount" ' e.g. "abc" if the address is abc@gmail.com
userPassword = "mypassword"
authenticationType = 1 ' cdoBasic
connectionTimeout = 30
' Required by Gmail
useSSL = True

Err.Clear()
On Error Resume Next

schema = "http://schemas.microsoft.com/cdo/configuration/"
Set mConfig = Sys.OleObject("CDO.Configuration")

mConfig.Fields.Item(schema & "sendusing") = 2 ' cdoSendUsingPort
mConfig.Fields.Item(schema & "smtpserver") = smtpServer
mConfig.Fields.Item(schema & "smtpserverport") = smtpPort
mConfig.Fields.Item(schema & "sendusername") = userLogin
mConfig.Fields.Item(schema & "sendpassword") = userPassword
mConfig.Fields.Item(schema & "smtpauthenticate") = authenticationType
mConfig.Fields.Item(schema & "smtpusessl") = useSSL
mConfig.Fields.Item(schema & "smtpconnectiontimeout") = connectionTimeout
mConfig.Fields.Update()

Set mMessage = Sys.OleObject("CDO.Message")
Set mMessage.Configuration = mConfig
mMessage.From = mFrom
mMessage.To = mTo
mMessage.Subject = mSubject
mMessage.HTMLBody = "email body:"&vbCrLf&mpath&vbCrLf&mBody


' If 0 < Len(mAttachment) Then
' mMessage.AddAttachment(mAttachment)
' mMessage.Attachments=false
' End If
mMessage.Fields.Update()

mMessage.Send()

If Err Then
Call Log.Warning("E-mail cannot be sent", Err.Description)
SendEMail = False
Err.Clear()
Else
Log.Message("Message to <" & mTo & "> was successfully sent")
SendEMail = True
End If
End Function