Récupérer des données et les envoyer en mail
Bonjour à tous,
Suite à la création d'un UserForm permettant de calculer des primes selon différents critères définit dans celui-ci (on rentre les informations, tout est calculé, récupéré et ensuite stocké dans un tableau), l'une des améliorations possibles serait d'envoyer un mail automatiquement à chaque personne dont la prime a été calculée afin de les prévenir. Il faudrait intégrer une RechercheV pour récupérer chaque données correspondante à l'employé pour que cela remplisse automatiquement le mail de référence qui sera toujours le même.
Est-ce possible de faire cela en VBA ?
Bonjour,
j'aimerais justement créer une macro ou même plusieurs si besoin pour récupérer les informations du tableau et les afficher dans un mail modèle.
Par exemple; si on tape le nom DUPONT, la macro récupère toutes les données liées à DUPONT qui sont stockées dans un tableau; nom, prénom, prime accordée, date de remplacement... Ces informations doivent êtres récupérées et affichées dans dans une lettre envoyée directement à cette personne. Je n'ai créé qu'un seul programme en VBA et je ne sais pas si cette amélioration est possible ou non
Cordialement
Voici un fichier d'exemple complet avec le formulaire et toute la structure, le plus de code possible a été enlevé pour les données confidentielles mais il devrait vous permettre de comprendre l'objectif final.
La limite de caractères est vraiment dérangeante, peut-on l'enlever ou la contourner ? Dans mon fichier principal (contenant toutes les données) lorsque l'on ajoute des personnes dans le tableau grâce au formulaire cela ne s'incrémente plus et remplace la ligne 80, les données ne se mettent pas à la suite, alors que ce problème n'est plus là dans le fichier d'exemple ci-dessous...
Merci pour votre aide
Cordialement
bonjour,
la moitié de la réponse. En ajoutant une forme "Mailbody" dans le fichier "envoi des mails" vous pouvez changer le contenu du body du mail. Dès que cela est prêt, vous pouvez envoyer vos mails.
Sub Envoyer()
Set sh = Sheets("envoi des mails")
tekst = sh.Shapes("MailBody").TextFrame2.TextRange.Characters.Text 'lees de tekst in die vorm uit
Set OutApp = CreateObject("Outlook.Application") 'outlook starten
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = sh.Range("B2").Value 'emailadres ontvanger
.CC = sh.Range("B5").Value
.BCC = Join(Array(sh.Range("B6").Value, sh.Range("B7").Value), ";")
.Subject = sh.Range("B1").Value
.Body = tekst
'.save 'sauvegarder
.Display
'.Send
End With
Set OutMail = Nothing
End SubMerci beaucoup pour cette réponse, c'est une façon de faire qui conviendrait parfaitement pour les courriers que nous avons à envoyer car il n'y a plus de problème de limite de caractère.
Il faut juste trouver un moyen de combiner la récupération de données qui se fait sur l'autre feuille et tout devrait fonctionner.
vous voulez des variables dans le body, okay, une maniere ,c'est de les remplacer ...
Sub Envoyer()
Set sh = Sheets("envoi des mails")
Set OutApp = CreateObject("Outlook.Application") 'outlook starten
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = sh.Range("B2").Value 'emailadres ontvanger
.CC = sh.Range("B5").Value
.BCC = Join(Array(sh.Range("B6").Value, sh.Range("B7").Value), ";")
.Subject = sh.Range("B1").Value
tekst = sh.Shapes("MailBody").TextFrame2.TextRange.Characters.Text 'lees de tekst in die vorm uit
tekst = Replace(tekst, "<<Personne>>", "Charles,")
tekst = Replace(tekst, "<<MonNom>>", "Bart")
tekst = Replace(tekst, "<<MaRue>>", "Avenue Louise 20")
tekst = Replace(tekst, "<<MaVille>>", "New York")
.Body = tekst
'.save 'sauvegarder
.Display
'.Send
End With
Set OutMail = Nothing
End Sub
Ce matin, j'ai répondu à une question parreille concernant envoyer des mails en "batch". Pour voir comment-le faire ...Votre code est équivalent à cette formule contenue dans mon fichier ?
=SI(AA2=0;"";"M/Mme "&A2&". Le remplacement de M/Mme "&V2&" "&W2&" à hauteur de "&P2&"%. ayant eu lieu du "&J2&" au "&K2&" votre prime est de "&AA2&"€ brut")
La formule fonctionne parfaitement et récupère bien les données, c'est uniquement la limite de caractères qui est gênante
=LIEN_HYPERTEXTE("mailto:"&AE83&"?subject="&AC83&"&cc="&$AF$2&"&body="&AD83;"Envoi des mails")
Est-il possible si on modifie un peu votre premier code de récupérer les données et les mettre dans la lettre modèle en enlevant la limite grâce à votre méthode MailBody ? Il faudrait que tout soit sur la même feuille je pense, pour éviter de compliquer le code...
re,
au lieu de ".body", on utilise mieux ".htmlbody" (voir https://forum.excel-pratique.com/excel/ecrire-une-mail-en-vba-171200) pour ajouter des changement de font, couleur, grandeur, ... .
Vous voulez quoi exactement dans le body ?
Bonjour, merci pour le lien je vais m'aider de cela.
J'aimerais récupérer les données du tableau contenant les informations des salariés et les inclure dans un texte à trous ce qui donnerait par exemple:
M/Mme "nom récupéré dans le tableau", vous avez remplacé M/Mme "nom récupéré" "prénom récupéré". Cette période de remplacement du "date récupérée" au "date récupérée" à hauteur de "pourcentage récupéré"% vous permet de bénéficier d'une prime de "montant récupéré"€.
Pour résumer, le formulaire permet de rentrer les informations des salariés et calculer leur prime selon des critères, c'est ensuite stockés dans une sorte de base de données et au moment où les informations sont stockées; un mail doit être envoyé automatiquement selon un modèle bien précis de lettre (seule les informations personnelles changent)
En regardant l'autre sujet que vous m'avez envoyé via le lien, le problème semble être le même. Cependant je n'arrive pas à comprendre si le code permet de chercher les données dans tout le tableau ou si la recherche s'effectue ligne par ligne. L'idéal serait de déclencher l'envoi du mail automatiquement après chaque rentrée de données. Mes explications ne sont peut-être pas claires... La mise en place d'une telle chose semble compliquées
bonjour,
Sub Envoyer()
Set sh = Sheets("envoi des mails")
Set lo = Sheets("stockagedonnees").ListObjects("tableau5")
With lo
Set dbr = .DataBodyRange
i_NR1 = 1 '.listcolumns("nom du remplaçant") --> probleme avec le c
i_PR1 = 3 'colum du prénom
i_NR2 = 22 '.listcolumns("nom du remplaçant") --> probleme avec le c
i_PR2 = 23 'colum du prénom
i_S1 = .ListColumns("Sexe").Range.Column - .Range.Column + 1
i_début = .ListColumns("date de début").Range.Column - .Range.Column + 1
i_fin = .ListColumns("date de fin").Range.Column - .Range.Column + 1
i_Dur = .ListColumns("durée en mois").Range.Column - .Range.Column + 1
i_mon = .ListColumns("montant de la prime finale").Range.Column - .Range.Column + 1
End With
Set outapp = CreateObject("Outlook.Application") 'outlook starten
Mon_Texte_de_Base = "<rouge><sexe1> <Nom1> <prénom1><normal>, <p>vous avez remplacé <rouge><sexe2> <Nom2> <prénom2><normal>.<p> Cette période de remplacement du <rouge><date1> au <date2><normal>,<br> à hauteur de <pourc1> vous permet de bénéficier d'une prime de <montant>.<p>"
For i = 1 To dbr.Rows.Count
If dbr(i, i_NR1) <> "" Then 'nom du remplacant est connu
Set OutMail = outapp.CreateItem(0)
With OutMail
.To = "remplacant" & i & "@rem.fr"
.Subject = "Changement de poste"
tekst = Mon_Texte_de_Base
tekst = Replace(tekst, "<sexe1>", IIf(dbr(i, i_S1) = "M", "Mr.", "Mme"))
tekst = Replace(tekst, "<Nom1>", dbr(i, i_NR1), , , vbTextCompare)
tekst = Replace(tekst, "<prénom1>", dbr(i, i_PR1), , , vbTextCompare)
tekst = Replace(tekst, "<sexe2>", IIf(dbr(i, i_S1) = "M", "Mr.", "Mme")) 'je n'ai pas vue une colonne "sexe2"
tekst = Replace(tekst, "<Nom2>", dbr(i, i_NR2), , , vbTextCompare)
tekst = Replace(tekst, "<prénom2>", dbr(i, i_PR2), , , vbTextCompare)
tekst = Replace(tekst, "<date1>", Format(dbr(i, i_début), "dddd dd-mmm-yy"), , , vbTextCompare)
tekst = Replace(tekst, "<date2>", Format(dbr(i, i_fin), "dddd dd-mmm-yy"), , , vbTextCompare)
tekst = Replace(tekst, "<pourc1>", Format(0.025, "0.00%"), , , vbTextCompare) 'colonne de % ?
tekst = Replace(tekst, "<montant>", Format(dbr(i, i_mon), "0.00€"), , , vbTextCompare)
tekst = Replace(tekst, "<rouge>", "<b><font size=""4"" font face=""calibri"" color=""red"">", , , vbTextCompare)
tekst = Replace(tekst, "<normal>", "</FONT></b>", , , vbTextCompare)
.HTMLBody = tekst
'.save 'sauvegarder
.Display
'.Send
End With
End If
Set OutMail = Nothing
Next
Set outapp = Nothing
End SubMerci beaucoup pour cette aide, je modifie le code pour ajouter ou enlever quelques éléments comme les caractères rouges qui ne sont pas utiles dans notre cas.
Il devrait être possible d'exécuter cette macro sur le bouton "Valider" du formulaire ? Dans le but de n'avoir qu'un clic à faire pour tout.
cela dépend de vous préferences, tous le codes dans le module du formulaire ou pas.
Dans ce cas dernier, le macro "envoyer" a besoin de 10 paramètres que le bouton "valider" du formulaire lui donne.
(je n'est pas testé, parce que je n'ai pas lu le reste, mais si les données sont correctes, ca doit fonctionner)
dans le formulaire
Envoyer cbosexe, prenom, prenom, cbosexe, nomremplace, prenomremplace, datedebut, datefin, pourc, rmhremplacé 'je ne suis pas sûr que tous ces variables sont bonnes
dans module1
Sub Envoyer(sexe1, nom1, prenom1, sexe2, nom2, prenom2, date1, date2, pourc, montant)D'accord, merci je vais essayer dans l'après-midi je vous redirai
Les données entrées dans le tableau ne se mettent plus à la suite et lorsque l'on en ajoute les anciennes sont remplacées. Par exemple si il y a ligne 204 DUPONT Pierre... et toutes ses données et qu'en utilisant le formulaire on ajoute EXEMPLE Paul, EXEMPLE Paul ne se met pas ligne 205 mais bien ligne 204 ce qui remplace DUPONT Pierre
Cela fonctionne de nouveau quand on efface tout le contenu du tableau mais que pour 3 ou 4 lignes et ce problème n'est pas présent dans tous les fichiers comme si le code trouvait des lignes non vides...
Le problème n'est pas présent dans le fichierexemple que je vous envoi, dans le cas où je ne trouve pas de solution je prendrais un ancien et j'ajouterais le code et les éléments manquants