Sujet Précédent Sujet Suivant

Envoi email automatique code VBA Outlook

lgvba Messages postés 6 Statut Membre -  
Mike-31 Messages postés 19572 Date d'inscription   Statut Contributeur Dernière intervention   -
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
A voir également:

8 réponses

Réponse 1 / 8
Morgothal Messages postés 1350 Statut Membre 184
 
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+
0
maloplekxus Messages postés 30 Statut Membre 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,
0
Réponse 2 / 8
Mike-31 Messages postés 19572 Date d'inscription   Statut Contributeur Dernière intervention   5 139
 
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
0
Réponse 3 / 8
lgvba Messages postés 6 Statut Membre
 
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
0
Réponse 4 / 8
Mike-31 Messages postés 19572 Date d'inscription   Statut Contributeur Dernière intervention   5 139
 
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.
0

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

Posez votre question
Réponse 5 / 8
lgvba Messages postés 6 Statut Membre
 
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
0
Réponse 6 / 8
Mike-31 Messages postés 19572 Date d'inscription   Statut Contributeur Dernière intervention   5 139
 
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.
0
Réponse 7 / 8
lgvba Messages postés 6 Statut Membre
 
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
0
Réponse 8 / 8
Mike-31 Messages postés 19572 Date d'inscription   Statut Contributeur Dernière intervention   5 139
 
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
0

Discussions similaires

Echec d'envoi message sur Messenger
Kris68 -
Colibri -

2 réponses