Envoi email automatique code VBA Outlook

lgvba Messages postés 5 Date d'inscription Statut Membre Dernière intervention -
Mike-31 Messages postés 18405 Date d'inscription Statut Contributeur Dernière intervention - 20 janv. 2013 à 22:06

sALU a tous

je souhaiterais ameliorer le code vba ci dessous afin d ' eviter le message d ' alerte 'autorisation d ' excel lors de l ' exécution pour l' envoie automatique d ' email via outlook lors de l execution de ma macro.

Aussi serait t ' il possible de rajouter dans le corp de mon courriel le message " Salu." .

je vous remercie d ' avance pour votre aide

LGVBA

Dim Destinataire As String, Sujet As String
 'Dim AccuseReception As Boolean
 Destinataire = Adresse_courriel
 Sujet = "Décompte personnel"
 ThisWorkbook.Sheets("Base courriel").Copy
 ActiveWorkbook.SendMail Destinataire, Sujet
 ActiveWorkbook.Close False

Mon code vba en entier

Sub aaa()
 
Dim Début As Integer, Fin As Integer, Grand_total As Currency, ID_traité As String, Nom_traité As String
 Dim feuillenom As String, i As Integer, Adresse_courriel As String
 
Application.ScreenUpdating = False
 
feuillenom = Date '& " - " & Hour(Time) & "h " & Minute(Time) & "m"
 
Sheets("Base").Copy After:=Sheets(1)
 'Sheets("Base2").Name = feuillenom
 Columns("F:F").NumberFormat = "#,##0.00"
 ActiveSheet.Shapes("Button 1").Delete
 
Range("A2").Activate
 
Retour:
 ID_traité = ActiveCell
 Nom_traité = ActiveCell.Offset(0, 1)
 
With Sheets("Adresses électroniques")
 For i = 2 To .Range("A65000").End(xlUp).Row
 If .Cells(i, 1) = ID_traité And .Cells(i, 2) = Nom_traité Then Adresse_courriel = .Cells(i, 3)
 Next i
 End With
 
Début = ActiveCell.Row
 Do Until ActiveCell <> ID_traité Or ActiveCell.Offset(0, 1) <> Nom_traité
 ActiveCell.Offset(1, 0).Activate
 Loop
 Fin = ActiveCell.Row - 1
 
Rows(Fin + 1 & ":" & Fin + 2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
 
Cells(ActiveCell.Row, 5) = "Total"
 Cells(ActiveCell.Row, 6) = WorksheetFunction.Sum(Range(Cells(Début, 6), Cells(Fin, 6)))
 Grand_total = Grand_total + Cells(ActiveCell.Row, 6)
 Range(Cells(ActiveCell.Row, 5), Cells(ActiveCell.Row, 6)).Font.Bold = True
 With Range(Cells(ActiveCell.Row, 5), Cells(ActiveCell.Row, 6)).Interior
 .Color = 5296274
 End With
 With Range(Cells(ActiveCell.Row, 5), Cells(ActiveCell.Row, 6))
 .BorderAround Weight:=xlMedium
 End With
 With Range(Cells(ActiveCell.Row + 1, 1), Cells(ActiveCell.Row + 1, 6)).Interior
 .ThemeColor = xlThemeColorDark1
 .TintAndShade = -0.349986266670736
 End With
 Range(Cells(Début, 1), Cells(Fin, 6)).Borders.Weight = xlThin
 
'Report individuel sur feuille "Base courriel"
 With Sheets("Base courriel")
 .Range("A2:F65000").Delete
 Range(Cells(Début, 1), Cells(Fin + 1, 6)).Copy Destination:=.Range("A2")
 End With
 


Dim Destinataire As String, Sujet As String
 Dim AccuseReception As Boolean
 Destinataire = Adresse_courriel
 Sujet = "Décompte personnel"
 ThisWorkbook.Sheets("Base courriel").Copy
 ActiveWorkbook.SendMail Destinataire, Sujet
 ActiveWorkbook.Close False
 
ActiveCell.Offset(2, 0).Activate
 If ActiveCell = "" Then
 Cells(Fin + 3, 5) = "Grand Total"
 Cells(Fin + 3, 6) = Grand_total
 Range(Cells(Fin + 3, 5), Cells(Fin + 3, 6)).Font.Bold = True
 With Range(Cells(Fin + 3, 5), Cells(Fin + 3, 6)).Interior
 .Color = 5296274
 End With
 With Range(Cells(Fin + 3, 5), Cells(Fin + 3, 6))
 .BorderAround Weight:=xlMedium
 End With

 Exit Sub
 End If
 
GoTo Retour
 
End Sub

Afficher la suite

A voir également:

Envoi email automatique code VBA Outlook
Code ascii - Guide
Réponse automatique thunderbird - Guide
Code puk bloqué - Guide
Comment creer un compte email - Guide
Code activation windows 10 - Guide

8 réponses

Réponse 1 / 8

Morgothal Messages postés 1236 Date d'inscription Statut Membre Dernière intervention 183

Bonjour,
Utiliser SendMail revient à utiliser Outlook via autre chose qu'Outlook et donc à déclencher ces alertes...

J'ai réussi à contourner ce problème en utilisant la librairie CDO. Tu peux te documenter via cet excellent site.

Je reste sur ce fil si jamais tu as des soucis.

A+

maloplekxus Messages postés 26 Date d'inscription Statut Membre Dernière intervention 3

Bonjour,

effectivement Morgothal t'a donné une bonne adresse pour l'envoi de message sans client de messagerie, avec ou sans pièce jointe et corps de texte et sans avoir besoin de cocher de référence dans VBA.

Voici le code que j'utilise :

 Sub SendMail()      

    Dim iMsg As Object, iConf As Object, Flds As Object      
    Dim texte As String 'déclaration variable texte pour le corps du message      
          
    'texte avec balise CSS pour la mise en forme puisque le corps du message est en html      
    texte = "<SPAN STYLE=background-color:white;font-size:12pt;font-family:Times New Roman>Bonjour,</SPAN><BR><BR>"      
    texte = texte & "<B><SPAN STYLE=background-color:white;font-size:18pt;font-family:arial>Essai</SPAN></B><BR><BR>"      
          
    Set iMsg = CreateObject("cdo.message")      
    Set iConf = CreateObject("cdo.configuration")      
    Set Flds = iConf.Fields      
    With Flds      
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2      
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "" 'adresse du serveur smtp (https://www.commentcamarche.net/faq/893-parametres-de-serveurs-pop-imap-et-smtp-des-principaux-fai      
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465 'tester 25, 465 ou 587      
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True  'Utilise une connection SSL (True or False)      
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60      
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1 '0 : pas d'authentification, 1 : authentification basique      
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "identifiant" 'identifiant de messagerie      
        .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "mot de passe" 'mot de passe de messagerie      
        .Update      
    End With      

    With iMsg      
        Set .Configuration = iConf      
        .From = "" 'adresse expéditeur      
        .To = "" 'adresse destinataire      
        .CC "" 'adresse destinataire en copie      
        .BCC = "" ' adresse destinataire en copie cachée      
        .Subject = "Envoi mail excel vba" 'sujet du message      
        .HTMLBody = texte 'variable texte (voir plus haut) = corps du message      
        .AddAttachment ("C:\Users....") 'ajout de pièce jointe 1      
        .AddAttachment ("C:\Users....") 'ajout de pièce jointe 2      
        .AddAttachment ("C:\Users....") 'ajout de pièce jointe 3. A répéter autant de fois que nécessaire dans la limite autorisé en Mo.      
        .Fields("urn:schemas:mailheader:disposition-notification-to") = "" 'adresse pour recevoir une notification de distribution.  En général c'est l'adresse de l'expéditeur.      
        .Fields("urn:schemas:mailheader:return-receipt-to") = "" 'adresse pour recevoir un accusé de réception. En général c'est l'adresse de l'expéditeur.      
        .Send      
    End With      
          
    End Sub

Va voir à cette adresse pour la configuration, en fonction de ton fournisseur d'accès internet (FAI) :

 https://www.commentcamarche.net/faq/893-parametres-de-serveurs-pop-imap-et-smtp-des-principaux-fai

Par contre avec le code actuel tu n'as pas de trace du message envoyé. Une solution simple consiste à te mettre en copie cachée.

Bien cordialement,

Réponse 2 / 8

Mike-31 Messages postés 18405 Date d'inscription Statut Contributeur Dernière intervention 5 135

Salut,

Tu peux t'appuyer sur cette discussion également ou tu trouveras un exemple et toutes les explications

https://forums.commentcamarche.net/forum/affich-26277766-envoi-d-une-selection-de-cellules-par-mail

Réponse 3 / 8

lgvba Messages postés 5 Date d'inscription Statut Membre Dernière intervention

Salut les gars ,

Malheusement, j arrive pas a appliquer la methode CDO a ma macro .
J' utilise Outlook pour les envois.

Voici La partie de ma macro ci dessous que je veut modifier afin d eviter le message d' alerte d 'excel .

Je vous joint le fichier en exemples afin que ce soit plus claire.

https://www.cjoint.com/?3Ardt2dD4uW

je vous remercie d ' avance

Dim Destinataire As String, Sujet As String
 'Dim AccuseReception As Boolean
 Destinataire = Adresse_courriel
 Sujet = "Décompte personnel"
 ThisWorkbook.Sheets("Base courriel").Copy
 ActiveWorkbook.SendMail Destinataire, Sujet
 ActiveWorkbook.Close False

Réponse 4 / 8

Mike-31 Messages postés 18405 Date d'inscription Statut Contributeur Dernière intervention 5 135

Re,

Je t'adapte un code CDO et te retournerai le fichier

Quel est ton fournisseur d'accès ou donne nous ton SMTP

dans ton corps de message veux tu accompagner d'un introduction
exemple Bonjour monsieur ou madame
l'objet de l'envoi
le corp proprement dit
formule de politesse
date et heure de l'envoi
si oui ces informations seront saisies directement dans le code ou sur une feuille de calcul comme d'ailleurs ladresse mail expéditeur et destinataire !

A+
Mike-31

Une période d'échec est un moment rêvé pour semer les graines du savoir.

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question

Réponse 5 / 8

lgvba Messages postés 5 Date d'inscription Statut Membre Dernière intervention

Merci mike ,

Mon smtp serais " smtpout.secureserver.net"

Oui je voudrais mettre l ' intro , l ' objet de l ' envoi , le corps de l ' envoi et formule de politesse ,

je vous rajouter un email adresse en copie cachee BCC, et un autre aussi en CC.
n ' oublie pas que je garde une trace de j ' ai envoyer via outlook

Je souhaiterais que ces informations soit sur la feuille de Calcul.

je te remercie pour ton aide.

lgvba

Réponse 6 / 8

Mike-31 Messages postés 18405 Date d'inscription Statut Contributeur Dernière intervention 5 135

Re,

Vite fait, regarde le fichier

https://www.cjoint.com/c/CAsjoaQs7JF

A+
Mike-31

Une période d'échec est un moment rêvé pour semer les graines du savoir.

Réponse 7 / 8

lgvba Messages postés 5 Date d'inscription Statut Membre Dernière intervention

merci mike

J ' ai du rajouter deux lignes de code afin de faire marcher ton envoi par cdo car j ' ai utiliser gmail comme smtp server.

mon problem maintenenant c ' est que la macro envoi la mauvaise piece jointe , il devrait m ' envoyer des "decompte individuel" , mais il fau qu ' il se base sur la feuille "base courriel" afin de creer le fichier temporaire qui se trouve dans ma premiiere macro " sub aaa".

De plus dans ta macro "proc_envoi il faut que objMessage.To = [M4].Value utilise ma variable prédéfinie Adresse_courriel qui se trouve dans la feuille "adresse électronique" afin d ' envoyer "le decompte individuel" en piece jointe , au bon email contact

Pourrais tu m ' aider a envoyer la bonne piece jointe et se baser sur la feuille "adresse electronique" pour l ' envoie au email lister dans la feuille

je te remercie d ' avance pour ton aide

Trouve ci joint la piece jointe , jai mis des commentaire

https://www.cjoint.com/?3AuuRsMI0Q7

Réponse 8 / 8

Mike-31 Messages postés 18405 Date d'inscription Statut Contributeur Dernière intervention 5 135

Re,

pour envoyer à plusieurs expéditeurs

objMessage.To = Sheets("Adresses électroniques").[C2].Value & "; " & Sheets("Adresses électroniques").[C3].Value & "; " & Sheets("Adresses électroniques").[C4].Value etc ...

mais tu aurais intérêt à nommer chaque cellule adresse ex. Adres1, Adres2 etc...
la formule se simplifirait à

objMessage.To = [Adres1].Value & "; " & [Adres2].Value & "; " & [Adres3].Value

idem pour la feuille à envoyer soit renseigne le nom de la feuille à envoyer soit nommer la plage

Discussions similaires

Echec d'envoi message sur Messenger

Envoie impossible messenger

Votre réponse

Discussions similaires