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 & "feuil1.xls"
ActiveWorkbook.Sheets("feuil1").Copy
ActiveWorkbook.SaveAs Filename:=fichier
Workbooks("feuil1.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") = ".......@gmail.com"
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "pass"
.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("feuil2").Select 'liste des emails'
Range("G1").Select
t = Range("G1:G10")
Destinataires = Join(Application.Transpose(t), ";")
strbody = "Bonjour, ............ Merci!"
With iMsg
Set .Configuration = iConf
.To = "mon email"
.cc = Destinataires
.BCC = ""
.From = """nom"" <mon email>"
.Subject = "test"
.TextBody = strbody
.AddAttachment fichier
.Send
Kill fichier
Sheets("--- ACCES AU PROGRAMME ---").Select
Range("a1").Select
MsgBox "Email bien envoyé Merci "
End With
End Sub