XL 2019 erreur .send

gothc

XLDnaute Occasionnel
bonjour j'ail une macro qui fonctionné avant mais elle ne fonctionne plus aujourd'hui je pense que google a modifier la sécurité
j'ai besoin de votre avis et la marche a suivre sur la sécurité google
VB:
Sub Mail_gmail()
Application.ScreenUpdating = False
Dim iMsg As Object, iConf As Object, strbody$, Fichier$
Dim Flds As Variant, t, Destinataires$

Fichier = ThisWorkbook.Path & Application.PathSeparator & "email.xls"
ActiveWorkbook.Sheets("email").Copy
ActiveWorkbook.SaveAs Filename:=Fichier
Workbooks("email.xls").Close True 'sans sauvegarde (True si sauvegarde)
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
iConf.Load -1 ' CDO Source Defaults
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") = "tatatat@gmail.com"
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "motpasse"
.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") = 465



.Update

End With


 Sheets("Paramètres_Application").Select
    Range("o2").Select
t = Range("o2:o10")
Destinataires = Join(Application.Transpose(t), ";")
'strbody = Worksheets("Paramètres_Application").Range("n2").Value & vbCrLf & vbCrLf
strbody = "veuillez trouver ci-joint  Cordialement    " & Worksheets("Paramètres_Application").Range("n2").Value & vbCrLf & vbCrLf
With iMsg
Set .Configuration = iConf
.To = "tatatat@gmail.com"
.CC = Destinataires
.BCC = ""
.From = """tonton"" <tatatat@gmail.com>"
.Subject = "dade du   " & Format(Date, "dd-mm-yyyy")
.TextBody = strbody
.AddAttachment Fichier
.Send
Kill Fichier



    Sheets("Feuil1").Select
    Range("a1").Select
  MsgBox "Email bien envoyé Merci "
End With

End Sub
 

Discussions similaires

Statistiques des forums

Discussions
312 209
Messages
2 086 259
Membres
103 167
dernier inscrit
miriame