Email automatique pour chaque ligne

lau26 · 16 Décembre 2008

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

juju_69 · 16 Décembre 2008

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

ROGER2327 · 16 Décembre 2008

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.

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

juju_69 · 16 Décembre 2008

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 🙂

ROGER2327 · 17 Décembre 2008

Re : Email automatique pour chaque ligne

RE-BONSOIR pour remercier juju 69 de sa réponse aussi claire que rapide.

Bonne nuit !
ROGER2327

nrdz83 · 17 Décembre 2008

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

ROGER2327 · 17 Décembre 2008

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

nrdz83 · 17 Décembre 2008

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

juju_69 · 17 Décembre 2008

Re : Email automatique pour chaque ligne

Hello,

Essaie de remplacer msg.To = ActiveCell.Value
par msg.To = s

@+

nrdz83 · 17 Décembre 2008

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

juju_69 · 17 Décembre 2008

Re : Email automatique pour chaque ligne

Pourquoi avoir rechangé ton code ? tu veux envoyer un mail unique à plusieurs personnes ou autant de mail que de personne ?

nrdz83 · 17 Décembre 2008

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

ROGER2327 · 17 Décembre 2008

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

juju_69 · 17 Décembre 2008

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

nrdz83 · 17 Décembre 2008

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 🙄

Email automatique pour chaque ligne

lau26

XLDnaute Nouveau

Pièces jointes

juju_69

XLDnaute Occasionnel

ROGER2327

XLDnaute Barbatruc

juju_69

XLDnaute Occasionnel

ROGER2327

XLDnaute Barbatruc

nrdz83

XLDnaute Impliqué

ROGER2327

XLDnaute Barbatruc

nrdz83

XLDnaute Impliqué

juju_69

XLDnaute Occasionnel

nrdz83

XLDnaute Impliqué

juju_69

XLDnaute Occasionnel

nrdz83

XLDnaute Impliqué

ROGER2327

XLDnaute Barbatruc

Pièces jointes

juju_69

XLDnaute Occasionnel

nrdz83

XLDnaute Impliqué

Discussions similaires

Email automatique pour chaque ligne

XLDnaute Nouveau

Pièces jointes

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Impliqué

XLDnaute Barbatruc

XLDnaute Impliqué

XLDnaute Occasionnel

XLDnaute Impliqué

XLDnaute Occasionnel

XLDnaute Impliqué

XLDnaute Barbatruc

Pièces jointes

XLDnaute Occasionnel

XLDnaute Impliqué

Discussions similaires

Privacy & Transparency

Privacy & Transparency