Envoi mail en vba avec corps message
Résolu/Fermé
benzi
Messages postés
66
Date d'inscription
samedi 5 mars 2005
Statut
Membre
Dernière intervention
28 juillet 2015
-
1 mars 2011 à 21:55
Mike-31 Messages postés 18346 Date d'inscription dimanche 17 février 2008 Statut Contributeur Dernière intervention 13 novembre 2024 - 12 avril 2011 à 21:14
Mike-31 Messages postés 18346 Date d'inscription dimanche 17 février 2008 Statut Contributeur Dernière intervention 13 novembre 2024 - 12 avril 2011 à 21:14
A voir également:
- Envoi mail en vba avec corps message
- Message - Guide
- Yahoo mail - Accueil - Mail
- Recuperer message whatsapp supprimé - Guide
- Message d'absence thunderbird - Guide
- Publipostage mail - Accueil - Word
23 réponses
benzi
Messages postés
66
Date d'inscription
samedi 5 mars 2005
Statut
Membre
Dernière intervention
28 juillet 2015
1
7 avril 2011 à 21:24
7 avril 2011 à 21:24
Bonsoir Mike,
Cela fonctionne très bien, c'est un super travail. Je te remercie beaucoup du coup de main et de ton implication.
Je vais d'ailleurs créer un nouveau post en donnant les explications et toutes les fonctionnalités du code car il y a eu plus de choses ajoutées par rapport à la demande initiale et cela pourrait aider du monde.
Une seule et dernière demande supplémentaire, à ce code peut-on ajouter une formule qui permet d'envoyer une seule feuille d'un classeur?
J'ai adapté le code à un fichier qui comporte plusieurs feuilles et je voudrai envoyer qu'une feuille.
Merci
A+
Dan
Cela fonctionne très bien, c'est un super travail. Je te remercie beaucoup du coup de main et de ton implication.
Je vais d'ailleurs créer un nouveau post en donnant les explications et toutes les fonctionnalités du code car il y a eu plus de choses ajoutées par rapport à la demande initiale et cela pourrait aider du monde.
Une seule et dernière demande supplémentaire, à ce code peut-on ajouter une formule qui permet d'envoyer une seule feuille d'un classeur?
J'ai adapté le code à un fichier qui comporte plusieurs feuilles et je voudrai envoyer qu'une feuille.
Merci
A+
Dan
benzi
Messages postés
66
Date d'inscription
samedi 5 mars 2005
Statut
Membre
Dernière intervention
28 juillet 2015
1
12 avril 2011 à 19:46
12 avril 2011 à 19:46
Bonsoir Mike,
Il y a 6 feuilles.
La 1 se nomme : Présentation
La 2 : Fiche technique
La 3 : Récap
La 4 : Menu
La 5 : Devis
La 6 : Facture
Il y aurait à expédier la 5 càd "Devis"
Par la suite j'essairai tout seul de faire la même chose avec "Facture"
Si tu veux plus de détails, dans la feuille 1 et 5 il y a un userform, dans chaque feuille des images (comme dans le planning) qui me permettent de revenir à la feuille "présentation" ainsi que d'autres formes.
Si tu as besoins d'autres infos, je te les donnent.
C'est le code que tu m'as donné et que j'utilise pour envoyer la feuille pour l'instant mais il ne supprime pas les formes et objets
A+
Dan
Il y a 6 feuilles.
La 1 se nomme : Présentation
La 2 : Fiche technique
La 3 : Récap
La 4 : Menu
La 5 : Devis
La 6 : Facture
Il y aurait à expédier la 5 càd "Devis"
Par la suite j'essairai tout seul de faire la même chose avec "Facture"
Si tu veux plus de détails, dans la feuille 1 et 5 il y a un userform, dans chaque feuille des images (comme dans le planning) qui me permettent de revenir à la feuille "présentation" ainsi que d'autres formes.
Si tu as besoins d'autres infos, je te les donnent.
C'est le code que tu m'as donné et que j'utilise pour envoyer la feuille pour l'instant mais il ne supprime pas les formes et objets
Option Explicit
Sub EnvoiMail()
Application.DisplayAlerts = False 'Supprime l'alerte Enregistrer
Dim objMessage As Variant
Dim nom As String
'ici on cré le chemin complet de ton fichier qui sera créé plus bas
nom = ActiveWorkbook.Path & "\Devis.xls"
'on crée le fichier et on le sauve avec le nom créé juste avant
'Copie la feuille dans le fichier à envoyer
ThisWorkbook.ActiveSheet.Copy '
'Supprime les controls ou tout activx
'Enregistre le fichier à envoyer davec le nom que l'on a cré plus haut
ActiveWorkbook.SaveAs nom
'Ferme le fichier
ActiveWorkbook.Close
On Error GoTo errorHandler
'on cré une instance de la reference "cdo" (message)
Set objMessage = CreateObject("CDO.Message")
'avec le message blablabla blablabla
With objMessage
.Subject = "Devis du " & Range("B13").Value
.From = Worksheets("Présentation").Range("K52").Value 'adresse mail de l'expéditeur n'est pas obligatoire
.To = Worksheets("Présentation").Range("K54").Value 'Email du destinataire doit-être correct ici
.Cci = Worksheets("Présentation").Range("K56").Value 'Email du destinataire en copie
'Crée le corps du message avec insertion de sauts de ligne
.TextBody = "Bonjour" & " " & Worksheets("Présentation").Range("C62").Value & "," & vbCrLf & vbCrLf _
& "Veuillez trouvez ci-joint le devis du " & Range("D10").Value & "." & vbCrLf & vbCrLf _
& "Cordialement " & vbCrLf _
& Worksheets("Présentation").Range("C66").Value & vbCrLf _
& Worksheets("Présentation").Range("C67").Value & vbCrLf & vbCrLf _
& Worksheets("Présentation").Range("C64").Value & vbCrLf _
& Worksheets("Présentation").Range("K61").Value & vbCrLf _
& Worksheets("Présentation").Range("K62").Value & vbCrLf _
& Worksheets("Présentation").Range("K63").Value & vbCrLf _
& Worksheets("Présentation").Range("K64").Value & vbCrLf & vbCrLf _
& Worksheets("Présentation").Range("K52").Value
.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.free.fr" 'remplacer ici le smtp par celui de son fournisseur d'accés
.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
.Configuration.Fields.Update
.AddAttachment (nom)
.Send
Dim Reponse
Reponse = MsgBox("Etes-sûr de vouloir effacer les coordonnées dans la feuille Préentation ? ", vbInformation + vbYesNo)
If Reponse = vbYes Then
Worksheets("Présentation").Range("K52:K56").Value = "" 'Efface les données dans la feuille Présentation dans les cellules K52 à K56
Worksheets("Présentation").Range("K61:K64").Value = "" ' K61 à K64
Worksheets("Présentation").Range("C62:C67").Value = "" ' C62 à C67
End If
MsgBox "Le mail a été bien envoyé !" 'Confirmation de l'envoi
'après l'envoi le fichier créé est supprimé
Kill ActiveWorkbook.Path & "\" & "Devis.xls"
'si erreur on sort de la procédure
Exit Sub
errorHandler:
'description de l'erreur survenue
MsgBox Err.Description
End With
End Sub
A+
Dan
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 12/04/2011 à 21:15
Modifié par Mike-31 le 12/04/2011 à 21:15
Re,
dans le code tu trouveras ce bout de code qui prévoit de supprimer toutes les feuilles d'un classeur sauf les feuilles nommées Devis, xx et xxxx
For Each x In Worksheets
If x.Name <> "Devis" And x.Name <> "XX" And x.Name <> "XXXX" Then x.Delete
Next
pour conserver que la feuille Devis tu peux écrire simplement cette ligne
If x.Name <> "Devis" Then x.Delete
le code complet
Sub Envoi_Mail()
'-------------------------------------------------------Création du nom du fichier d'envoi
[A2] = "Planning " & Format(Range("C9").Value, "mmm yy") & ".xls"
Dim chemin, nom, renom As String
Dim x As Worksheet
chemin = ActiveWorkbook.Path
nom = [A2]
renom = "Planning"
'--------------------------------------------------Création du fichier d'envoi
Application.DisplayAlerts = False '------------------Annulation des alertes
ActiveWorkbook.Save
ActiveWorkbook.SaveAs Filename:=chemin & "\" & nom
'--------------------------------------------------Retour sur le fichier initial
ActiveWorkbook.SaveAs Filename:=chemin & "\" & renom
Workbooks.Open Filename:=chemin & "\" & nom
ActiveSheet.Shapes("Rectangle 80").Visible = False 'Masquer le bouton d'envoi
Range("A2:B2,K52:N52,K54:N54,K56:N56").ClearContents 'Supprimer adresses mail sur le fichier à envoyer
'--------------------------------------------------Supprimer éventuellement la feuille nommée "Feuil1"
For Each x In Worksheets
If x.Name <> "Devis" And x.Name <> "XX" And x.Name <> "XXXX" Then x.Delete
Next
'--------------------------------------------------Enregistrement et fermeture du classeur à expédier
ActiveWorkbook.Save
ActiveWorkbook.Close
'--------------------------------------------------Appel de la procédure d'envoi
Call Procédure_Envoi
'--------------------------------------------------Suppression du fichier après envoi
Kill ActiveWorkbook.Path & "\" & [A2].Value
'--------------------------------------------------Effacement des cellules de création du nom du fichier envoyé
[A2:B2].ClearContents
ActiveWorkbook.Save
Application.DisplayAlerts = True '------------------rétablissement des alertes
End Sub
Sub Procédure_Envoi()
Dim messageHTML As Variant
Dim objMessage As Variant
Dim piece_jointe As Variant
'--------------------------------------------------crée le fichier à envoyer
On Error GoTo errorHandler
Set objMessage = CreateObject("CDO.Message")
objMessage.Subject = "P1 du " & Range("H4").Value
objMessage.From = Range("K52").Value '---------------adresse mail de l'expéditeur n'est pas obligatoire
objMessage.To = Range("K54").Value '---------------Email du destinataire doit-être correct ici
objMessage.Cc = Range("K56").Value '---------------Email du destinataire en copie
'-------------------------------------------------Création le corps du message avec insertion de sauts de ligne
objMessage.TextBody = "Bonjour" & " " & Range("C62").Value & "," & vbCrLf & vbCrLf _
& "Veuillez trouvez ci-joint le P1 " & Range("C64").Value & "." & vbCrLf & vbCrLf _
& "Cordialement " & vbCrLf _
& Range("C66").Value & vbCrLf _
& Range("C67").Value & vbCrLf & vbCrLf _
& Range("C64").Value & vbCrLf _
& Range("K61").Value & vbCrLf _
& Range("K62").Value & vbCrLf _
& Range("K63").Value & vbCrLf _
& Range("K64").Value & vbCrLf & vbCrLf _
& Range("K52").Value
'-------------------------------------------------Sélectionnes la pièce à joindre
piece_jointe = ActiveWorkbook.Path & "\" & [A2].Value '"Planning janv 11.xls" '"Planning.xls"
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.free.fr" 'remplacer ici le smtp par celui de son fournisseur d'accés
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
objMessage.Configuration.Fields.Update
objMessage.AddAttachment (piece_jointe)
objMessage.Send
MsgBox "Le mail a été bien envoyé !" '---------------Confirmation de l'envoi
'------------------------------------------------Si erreur on sort de la procédure
Exit Sub
errorHandler:
'------------------------------------------------Description de l'erreur survenue
MsgBox Err.Description
End Sub
et le lien du fichier
https://www.cjoint.com/?ADmvnyiUoc8
A+
Mike-31
Une période d'échec est un moment rêvé pour semer les graines du savoir.
dans le code tu trouveras ce bout de code qui prévoit de supprimer toutes les feuilles d'un classeur sauf les feuilles nommées Devis, xx et xxxx
For Each x In Worksheets
If x.Name <> "Devis" And x.Name <> "XX" And x.Name <> "XXXX" Then x.Delete
Next
pour conserver que la feuille Devis tu peux écrire simplement cette ligne
If x.Name <> "Devis" Then x.Delete
le code complet
Sub Envoi_Mail()
'-------------------------------------------------------Création du nom du fichier d'envoi
[A2] = "Planning " & Format(Range("C9").Value, "mmm yy") & ".xls"
Dim chemin, nom, renom As String
Dim x As Worksheet
chemin = ActiveWorkbook.Path
nom = [A2]
renom = "Planning"
'--------------------------------------------------Création du fichier d'envoi
Application.DisplayAlerts = False '------------------Annulation des alertes
ActiveWorkbook.Save
ActiveWorkbook.SaveAs Filename:=chemin & "\" & nom
'--------------------------------------------------Retour sur le fichier initial
ActiveWorkbook.SaveAs Filename:=chemin & "\" & renom
Workbooks.Open Filename:=chemin & "\" & nom
ActiveSheet.Shapes("Rectangle 80").Visible = False 'Masquer le bouton d'envoi
Range("A2:B2,K52:N52,K54:N54,K56:N56").ClearContents 'Supprimer adresses mail sur le fichier à envoyer
'--------------------------------------------------Supprimer éventuellement la feuille nommée "Feuil1"
For Each x In Worksheets
If x.Name <> "Devis" And x.Name <> "XX" And x.Name <> "XXXX" Then x.Delete
Next
'--------------------------------------------------Enregistrement et fermeture du classeur à expédier
ActiveWorkbook.Save
ActiveWorkbook.Close
'--------------------------------------------------Appel de la procédure d'envoi
Call Procédure_Envoi
'--------------------------------------------------Suppression du fichier après envoi
Kill ActiveWorkbook.Path & "\" & [A2].Value
'--------------------------------------------------Effacement des cellules de création du nom du fichier envoyé
[A2:B2].ClearContents
ActiveWorkbook.Save
Application.DisplayAlerts = True '------------------rétablissement des alertes
End Sub
Sub Procédure_Envoi()
Dim messageHTML As Variant
Dim objMessage As Variant
Dim piece_jointe As Variant
'--------------------------------------------------crée le fichier à envoyer
On Error GoTo errorHandler
Set objMessage = CreateObject("CDO.Message")
objMessage.Subject = "P1 du " & Range("H4").Value
objMessage.From = Range("K52").Value '---------------adresse mail de l'expéditeur n'est pas obligatoire
objMessage.To = Range("K54").Value '---------------Email du destinataire doit-être correct ici
objMessage.Cc = Range("K56").Value '---------------Email du destinataire en copie
'-------------------------------------------------Création le corps du message avec insertion de sauts de ligne
objMessage.TextBody = "Bonjour" & " " & Range("C62").Value & "," & vbCrLf & vbCrLf _
& "Veuillez trouvez ci-joint le P1 " & Range("C64").Value & "." & vbCrLf & vbCrLf _
& "Cordialement " & vbCrLf _
& Range("C66").Value & vbCrLf _
& Range("C67").Value & vbCrLf & vbCrLf _
& Range("C64").Value & vbCrLf _
& Range("K61").Value & vbCrLf _
& Range("K62").Value & vbCrLf _
& Range("K63").Value & vbCrLf _
& Range("K64").Value & vbCrLf & vbCrLf _
& Range("K52").Value
'-------------------------------------------------Sélectionnes la pièce à joindre
piece_jointe = ActiveWorkbook.Path & "\" & [A2].Value '"Planning janv 11.xls" '"Planning.xls"
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.free.fr" 'remplacer ici le smtp par celui de son fournisseur d'accés
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
objMessage.Configuration.Fields.Update
objMessage.AddAttachment (piece_jointe)
objMessage.Send
MsgBox "Le mail a été bien envoyé !" '---------------Confirmation de l'envoi
'------------------------------------------------Si erreur on sort de la procédure
Exit Sub
errorHandler:
'------------------------------------------------Description de l'erreur survenue
MsgBox Err.Description
End Sub
et le lien du fichier
https://www.cjoint.com/?ADmvnyiUoc8
A+
Mike-31
Une période d'échec est un moment rêvé pour semer les graines du savoir.