Email automatique pour chaque ligne

L

lau26

XLDnaute Nouveau
Bonjour,

Merci à ce forum et à tous ceux qui m'ont aidé précédemment, maintenant je commence à taquiner l'excel et ses fonctions;

Mais me revoici pour un problème qui apparemment ne pourrait se résoudre avec les fonctions habituelles d'excel, sinon avec du visual basic ou une macro (mais j'y connais strictement rien à ce sujet)

En pièce jointe, j'ai mis l'ébauche de mon nouveau travail :
il s'agit d'un tableau que je complèterai à chaque fois qu'un étudiant veut changer d'institution, et j'aimerai donc automatiser l'envoi d'email après chaque entrée (par exemple en mettant un bouton "envoyer information" à chaque ligne). auriez-vous une idée ? est-ce possible ?

Merci d'avance
 

Pièces jointes

  • Transfert UN-AF 2009 test.xls
    34.5 KB · Affichages: 73
Trier par date Trier par votes
J

juju_69

XLDnaute Occasionnel
Re : Email automatique pour chaque ligne

Hello,

Voici une macro pour les mails :

Sub Mail ()
Dim ol As Object
Dim olmail As Object
Dim CurrFile As Object
Set ol = CreateObject("Outlook.Application")
Set olmail = ol.CreateItem(0)
With olmail
.To = cells(selection.row,6).Value
.Subject = "Objet"
.Body = "Sujet"
'Remplacez .Display par .send pour envoyer directement l'e-mail
.Display
End With
End Sub

L'idée c'est de mettre un seul bouton Mail et de te positionner sur la ligne à envoyer avant de cliquer dessus. Pour le sujet et l'objet tu peux reprendre la formule de récup du mail pour récupérer les infos que tu souhaites

@ +

Juju
 
Vote positif 0 Vote négatif
ROGER2327

ROGER2327

XLDnaute Barbatruc
Re : Email automatique pour chaque ligne

Bonjour à vous,
La procédure proposée par juju_69 fonctionne ; c'est "un classique" cité en de nombreux endroits (on le trouve presque tel quel dans un fichier d'aide d'Excel®) :
L'exemple Microsoft Visual Basic/Visual Basic pour Applications (VBA) suivant montre comment créer un objet MailItem et définir la propriété BodyFormat sur la valeur olFormatHTML. Le corps de texte de l'élément de messagerie électronique apparaît alors au format HTML.
Cliquez pour agrandir...
Code: 
Sub CreateHTMLMail()
'Creates a new e-mail item and modifies its properties

    Dim olApp As Outlook.Application
    Dim objMail As Outlook.MailItem
    Set olApp = Outlook.Application
    'Create e-mail item
    Set objMail = olApp.CreateItem(olMailItem)

    With objMail
       'Set body format to HTML
       .BodyFormat = olFormatHTML
       .HTMLBody = "<HTML><H2>The body of this message will appear in HTML.</H2><BODY>Please enter the message text here. </BODY></HTML>"
       .Display
    End With

End Sub
Ce qui m'étonne dans la procédure de juju_69, c'est :
Code: 
Dim CurrFile As Object
dont je ne vois pas l'utilité. Pourriez-vous m'expliquer pourquoi cette ligne est présente dans le code ? Merci d'avance.​
ROGER2327
 
Vote positif 0 Vote négatif
J

juju_69

XLDnaute Occasionnel
Re : Email automatique pour chaque ligne

Salut Roger,
J'ai fait un copier coller de mon code dans lequel je gère un fichier en pièce jointe. Dans la demande présente, n'ayant pas besoin de gérer de pièce jointe j'ai enlevé la ligne de code mais j'ai oublié d'enlever la variable... Voila tout :)
 
Vote positif 0 Vote négatif
nrdz83

nrdz83

XLDnaute Impliqué
Re : Email automatique pour chaque ligne

bonsoir à tous voila moi j'utilise ce code il fonctionne bien sauf qu'il m'envoe autant de message que j'ai de destinataire. N'est il pas possible d'envoyer un seul message avec AA: et CC: ? merci pour vos lumière s

Sub envoi_Feuille()
répertoireAppli = ActiveWorkbook.Path ' Penser à Outils/Références Outlook
Sheets("plongée journalière ").Copy ' crée un classeur avec la feuille plongée journalière
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs répertoireAppli & "\Plongée du jour.xls"
ActiveWindow.Close
'--- Envoi par mail
Dim olapp As Outlook.Application
Sheets("Destinataires").Select
Range("A11").Select
Do While Not IsEmpty(ActiveCell)
Dim msg As MailItem
Set olapp = New Outlook.Application
Set msg = olapp.CreateItem(olMailItem)
msg.To = ActiveCell.Value
msg.Subject = Range("A2").Value
msg.Body = Range("A5").Value & Chr(13) & Chr(13) & Range("A8").Value & Chr(13) & Chr(13)
msg.Attachments.Add Source:=répertoireAppli & "\Plongée du jour.xls"
msg.Send
ActiveCell.Offset(1, 0).Select
Loop
UserForm2.Hide
End Sub

amitiés
 
Vote positif 0 Vote négatif
ROGER2327

ROGER2327

XLDnaute Barbatruc
Re : Email automatique pour chaque ligne

Bonsoir à nrdz83.
Pour placer plusieurs destinataires dans un même message, j'utilise le code :
Code: 
Dim s As String, i As Long
For i = 2 To 4
    s = s & Cells(i, 1).Value & "; "
Next i
    s = Left$(s, Len(s) - 2)
pour construire une chaîne de caractères s = "Adresse1; Adresse2; Adresse3" à partir des adresses situées en A2, A3, A4 de la feuille active. J'utilise ensuite le code :
Code: 
    msg.To = s
ou
Code: 
    msg.BCC = s
selon le besoin.​
J'ai effectivement testé cette solution avec succès.​
Bonne nuit !
ROGER2327
 
Vote positif 0 Vote négatif
nrdz83

nrdz83

XLDnaute Impliqué
Re : Email automatique pour chaque ligne

bonjour à tous , bonjour roger voila j'ai fais ce code avec tes données mais il plante peut être que j'ai mal positionné les codes? d'avance merci pour votre aide , amitiés .

Sub envoi_Feuille()
répertoireAppli = ActiveWorkbook.Path ' Penser à Outils/Références Outlook
Sheets("plongée journalière ").Copy ' crée un classeur avec la feuille plongée journalière
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs répertoireAppli & "\Plongée du jour.xls"
ActiveWindow.Close
'--- Envoi par mail
Dim olapp As Outlook.Application
Sheets("Destinataires").Select
Range("A11").Select
msg.To = s
Do While Not IsEmpty(ActiveCell)
Dim s As String, i As Long
For i = 2 To 4
s = s & Cells(i, 1).Value & "; "
Next i
s = Left$(s, Len(s) - 2)
Set olapp = New Outlook.Application
Set msg = olapp.CreateItem(olMailItem)
msg.To = ActiveCell.Value
msg.Subject = Range("A2").Value
msg.Body = Range("A5").Value & Chr(13) & Chr(13) & Range("A8").Value & Chr(13) & Chr(13)
msg.Attachments.Add Source:=répertoireAppli & "\Plongée du jour.xls"
msg.Send
ActiveCell.Offset(1, 0).Select
Loop
UserForm2.Hide
End Sub
 
Vote positif 0 Vote négatif
nrdz83

nrdz83

XLDnaute Impliqué
Re : Email automatique pour chaque ligne

bonsoir le forum et juju 69 merci pour ton aide j'ai maintenant cette erreur sur la photo, merci pour ton aide mes amitiés

[/url][/IMG]

et voici donc mon code actuel

Sub envoi_Feuille()
répertoireAppli = ActiveWorkbook.Path ' Penser à Outils/Références Outlook
Sheets("plongée journalière ").Copy ' crée un classeur avec la feuille plongée journalière
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs répertoireAppli & "\Plongée du jour.xls"
ActiveWindow.Close
'--- Envoi par mail
Dim olapp As Outlook.Application
Sheets("Destinataires").Select
Range("A11").Select
Do While Not IsEmpty(ActiveCell)
Dim msg As MailItem
Set olapp = New Outlook.Application
Set msg = olapp.CreateItem(olMailItem)
msg.To = s
msg.Subject = Range("A2").Value
msg.Body = Range("A5").Value & Chr(13) & Chr(13) & Range("A8").Value & Chr(13) & Chr(13)
msg.Attachments.Add Source:=répertoireAppli & "\Plongée du jour.xls"
msg.Send
ActiveCell.Offset(1, 0).Select
Loop
UserForm2.Hide
End Sub
 
Vote positif 0 Vote négatif
nrdz83

nrdz83

XLDnaute Impliqué
Re : Email automatique pour chaque ligne

re bonsoir je souhaite envoyer le meme mail à plusieurs destinateurs.

J'ai changé car j'avais l'erreur suivante;

Sub envoi_Feuille()
répertoireAppli = ActiveWorkbook.Path ' Penser à Outils/Références Outlook
Sheets("plongée journalière ").Copy ' crée un classeur avec la feuille plongée journalière
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs répertoireAppli & "\Plongée du jour.xls"
ActiveWindow.Close
'--- Envoi par mail
Dim olapp As Outlook.Application
Sheets("Destinataires").Select
Range("A11").Select
msg.To = s
Do While Not IsEmpty(ActiveCell)
Dim s As String, i As Long
For i = 2 To 4
s = s & Cells(i, 1).Value & "; "
Next i
s = Left$(s, Len(s) - 2)
Set olapp = New Outlook.Application
Set msg = olapp.CreateItem(olMailItem)
msg.To = s
msg.Subject = Range("A2").Value
msg.Body = Range("A5").Value & Chr(13) & Chr(13) & Range("A8").Value & Chr(13) & Chr(13)
msg.Attachments.Add Source:=répertoireAppli & "\Plongée du jour.xls"
msg.Send
ActiveCell.Offset(1, 0).Select
Loop
UserForm2.Hide
End Sub
avec cette erreur d'affiché>> erreur de compilation ; declaration existante dans la portée en cour

merci pour ton aide amitiés
 
Vote positif 0 Vote négatif
ROGER2327

ROGER2327

XLDnaute Barbatruc
Re : Email automatique pour chaque ligne

Bonsoir à tous
Plus spécialement pour nrdz83, je joins un classeur de démonstration avec une procédure qui fonctionne. J'ai passé plusieurs heures à le rédiger proprement, aussi serait-il bon que vous lussiez attentivement la feuille NOTICE dans laquelle vous trouverez le pourquoi du comment ça marche. Votre problème n'est pas réellement compliqué mais vous ne simplifiez pas la tâche de vos interlocuteurs en ne fournissant pas un classeur type. Si vous aviez, dès le début, donné la structure du classeur, et spécialement de la feuille Destinataires, les réponses des uns et des autres eussent été plus rapide.​
Cela étant dit, votre problème est intéressant pour beaucoup d'entre-nous, et j'espère que ma réponse pourra rendre service à quelques-uns.​
Version finale du code :
Code: 
Sub envoi_Feuille_REV_3()
' Avant de lancer cette macro : Dans l'éditeur VBA, faire
' Menu / Outils / Références... /
' et cocher "Microsoft Outlook 11.0 Object Library"
Dim répertoireAppli As String, olapp As New Outlook.Application, msg As MailItem, s As String
    Application.ScreenUpdating = False
    répertoireAppli = ActiveWorkbook.Path
    Sheets("plongée journalière ").Copy
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs répertoireAppli & "\Plongée du jour.xls"
    Application.DisplayAlerts = True
    ActiveWindow.Close
    Application.ScreenUpdating = True
    Sheets("Destinataires").Activate
    Range("A11").Select
    Do While Not IsEmpty(ActiveCell)
        s = s & ActiveCell.Value & "; "
        ActiveCell.Offset(1, 0).Select
    Loop
    s = Left$(s, Len(s) - 2)
    Set msg = olapp.CreateItem(olMailItem) ' Envoi par mail
    msg.To = s
    msg.Subject = Range("A2").Value
    msg.Body = Range("A5").Value & Chr(13) & Chr(13) & Range("A8").Value & Chr(13) & Chr(13)
    msg.Attachments.Add répertoireAppli & "\Plongée du jour.xls"
    msg.Send
End Sub
Bonne nuit !
ROGER2327
 

Pièces jointes

  • Classeur_pédago.zip
    19.3 KB · Affichages: 57
Vote positif 0 Vote négatif
J

juju_69

XLDnaute Occasionnel
Re : Email automatique pour chaque ligne

C'est normal tu déclares ta variable après. essaie comme çà

'--- Envoi par mail
Dim olapp As Outlook.Application
Sheets("Destinataires").Select
Dim s As String, i As Long
For i = 2 To 4
s = s & Cells(i, 1).Value & "; "
Next i
's = Left$(s, Len(s) - 2)
Set olapp = New Outlook.Application
Set msg = olapp.CreateItem(olMailItem)
msg.To = s
msg.Subject = Range("A2").Value
msg.Body = Range("A5").Value & Chr(13) & Chr(13) & Range("A8").Value & Chr(13) & Chr(13)
msg.Attachments.Add Source:=répertoireAppli & "\Plongée du jour.xls"
msg.Send
ActiveCell.Offset(1, 0).Select
UserForm2.Hide
End Sub

Sinon peut être joins nous un exemple de ton fichier

Edit : Kikou Roger, dsl pour le carambolage^^
Edit2 : et ben Roger sacré boulot que tu as fait là, clap clap
 
Dernière édition:
Vote positif 0 Vote négatif
nrdz83

nrdz83

XLDnaute Impliqué
Re : Email automatique pour chaque ligne

bonsoir roger et juju 69 impec franchement trop fort, et surtout trés pédagogique roger la je comprend vraiment. J'ai passé presque la journée a cherchez sur les autres codes que j'avais glané ici et là, suis tré sreconnaissant à vous deux et je vous souhaite un peu en avance certes de tres bonnes fêtes de fin d'année mes amitiés et encore chapeau et merci , bye :rolleyes:
 
Vote positif 0 Vote négatif

Discussions similaires

M
  • Question
[Projet de simulation d'un site Web] Fonctionnalités simples d'eBay
Réponses
0
Affichages
2 K
MrBstone
M
B
  • Question
Codes VBA pour calcul emprunt
Réponses
2
Affichages
10 K
britchouleloup
B
M
[REF] Wiki Page 10 de MichelXld
Réponses
0
Affichages
30 K
MichelXld
M
M
[REF] Wiki 3 de MichelXld (Piloter d'autres applications depuis Excel)
Réponses
0
Affichages
80 K
MichelXld
M

Membres actuellement en ligne

Aucun membre en ligne actuellement.
0 membres et 24 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 229
Messages
2 086 426
Membres
103 206
dernier inscrit
diambote