Microsoft 365 Envoyer un mail avec un copier/coller de cellules

LeLigérien à dit:

envoie automatiquement le mail par Gmail

Cliquez pour agrandir...

code :

Sub Envoyer_Email_Gmail()

Dim objOutlook As Object
Dim objMail As Object
Dim rng As Range
Dim strSubject As String
Dim strBody As String
Dim strRecipient As String
Dim i As Integer
Dim AttachFile As String

' Adresse e-mail et mot de passe du compte Gmail utilisé pour envoyer des e-mails
Const GmailAdresse As String = "adresse@gmail.com"
Const GmailMotDePasse As String = "mot_de_passe"

' Définir le sujet, le corps et le nom du fichier attaché
strSubject = "Sujet de l'e-mail"
strBody = "Corps de l'e-mail"
AttachFile = "Nom_du_fichier_attaché.xlsx"

' Créer un objet Outlook
Set objOutlook = CreateObject("Outlook.Application")

' Définir la plage de cellules contenant les adresses e-mail
Set rng = Range("C14:C17")

' Parcourir chaque cellule de la plage
For i = 1 To rng.Rows.Count
' Vérifier que la cellule contient une adresse e-mail valide
If InStr(1, rng.Cells(i, 1).Value, "@") > 0 Then
' Ajouter l'adresse e-mail à la liste des destinataires
strRecipient = strRecipient & rng.Cells(i, 1).Value & ";"
End If
Next i

' Créer un nouvel e-mail
Set objMail = objOutlook.CreateItem(0)

' Ajouter les destinataires, le sujet et le corps
objMail.To = strRecipient
objMail.Subject = strSubject
objMail.Body = strBody

' Ajouter le fichier attaché
objMail.Attachments.Add ActiveWorkbook.FullName

' Envoyer l'e-mail via Gmail
With objMail
.SentOnBehalfOfName = GmailAdresse
.Save
.SendUsingAccount = objOutlook.Session.Accounts.Item(GmailAdresse)
.Send
End With

' Libérer les objets Outlook
Set objMail = Nothing
Set objOutlook = Nothing

End Sub

Cliquez pour agrandir...

LeLigérien à dit:

@fanch55 : La macro ne fonctionne pas j'ai un message qui dit qu'il trouve pas mon adresse mail.

Cliquez pour agrandir...