Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

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

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…