Sujet Précédent Sujet Suivant

Envoi email automatique code VBA Outlook

Fermé
lgvba Messages postés 5 Date d'inscription mercredi 14 novembre 2012 Statut Membre Dernière intervention 20 janvier 2013 - 16 janv. 2013 à 05:52
Mike-31 Messages postés 18346 Date d'inscription dimanche 17 février 2008 Statut Contributeur Dernière intervention 13 novembre 2024 - 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
A voir également:

8 réponses

Réponse 1 / 8
Morgothal Messages postés 1236 Date d'inscription jeudi 22 avril 2010 Statut Membre Dernière intervention 19 mai 2015 183
16 janv. 2013 à 13:57
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 26 Date d'inscription mercredi 16 janvier 2013 Statut Membre Dernière intervention 20 août 2014 3
Modifié par maloplekxus le 16/01/2013 à 16:17
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 18346 Date d'inscription dimanche 17 février 2008 Statut Contributeur Dernière intervention 13 novembre 2024 5 104
16 janv. 2013 à 14:03
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 5 Date d'inscription mercredi 14 novembre 2012 Statut Membre Dernière intervention 20 janvier 2013
17 janv. 2013 à 03:22
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 18346 Date d'inscription dimanche 17 février 2008 Statut Contributeur Dernière intervention 13 novembre 2024 5 104
Modifié par Mike-31 le 17/01/2013 à 09:28
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 5 Date d'inscription mercredi 14 novembre 2012 Statut Membre Dernière intervention 20 janvier 2013
18 janv. 2013 à 04:28
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 18346 Date d'inscription dimanche 17 février 2008 Statut Contributeur Dernière intervention 13 novembre 2024 5 104
Modifié par Mike-31 le 18/01/2013 à 09:14
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 5 Date d'inscription mercredi 14 novembre 2012 Statut Membre Dernière intervention 20 janvier 2013
20 janv. 2013 à 20:56
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 18346 Date d'inscription dimanche 17 février 2008 Statut Contributeur Dernière intervention 13 novembre 2024 5 104
20 janv. 2013 à 22:06
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

Échec d’envoie message messenger
Kris68 -
Colibri -

2 réponses
je voudrais récupérer mon adresse e mail
clobel -
Lucio -

19 réponses