Envoi mail en vba avec corps message

Version imprimable

Voir 40 message(s) de cette discussion en une page

15/03/2011, 23h24
AlainTech

Objet requis veut dire que tu n'as rien avant ton point.
Autrement dit, tu n'as pas mis cette ligne dans un bloc With... End With.

Je me trompe?
16/03/2011, 17h25
patricktoulon

re

bonjour

bon essai un msgbox avec form_piece jointe.value et dis moi ce que ca donne?

au plaisir

Bonjour,

Pourtant c'est bien entre With et End With, voici le code:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
With iMsg
    Set .Configuration = iConf
    .To = "destmail@free.fr" 
    .From = "monmail@free.fr" 
    .Subject = "P1 du 5974" 'ici le titre
  '""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
  'mise en forme du paragraphe au format "HTML"
   paragraphe = ""
paragraphe = paragraphe & "<HEAD>" & Chr(13)
paragraphe = paragraphe & "<BODY>" & Chr(13)
'************************************
paragraphe = paragraphe & "<BR>" & "Bonjour Olivier<BR>" & vbCrLf & vbCrLf
paragraphe = paragraphe & "<BR>Veuillez trouvez ci-joint le P1" & Range("C94").Value & "<BR> " & vbCrLf & vbCrLf
paragraphe = paragraphe & "<BR>Cordialement<BR> " & vbCrLf
paragraphe = paragraphe & "<BR>Prénom Nom<BR> "
paragraphe = paragraphe & "<BR>Chef Gérant<BR>" & vbCrLf & vbCrLf
paragraphe = paragraphe & "<BR>Les Floralies <BR> " & vbCrLf
paragraphe = paragraphe & "<BR>" & Range("G94").Value & "<BR>" & vbCrLf
paragraphe = paragraphe & "<BR>" & Range("G95").Value & "<BR>" & vbCrLf
paragraphe = paragraphe & "<BR>" & Range("G96").Value & "<BR>" & vbCrLf
paragraphe = paragraphe & "<BR>" & Range("G87").Value & "<BR>" & vbCrLf
 
    paragraphe = paragraphe & "</BODY>"
paragraphe = paragraphe & ""
 
 .HTMLBody = paragraphe
.AddAttachment "C:\Documents and Settings\Daniel\Bureau\Dossier xyz\FB\" & form_mail.PIECE_JOINTE
    .Send
End With
MsgBox "LE DOCUMENT A ETE TRANSMIS "
 
End Sub

Cordialement

Dan

16/03/2011, 18h26
danbenzi

Bonjour Patrick,

Cela donne pas "grand chose" car à vrai dire je ne sais pas comment le mettre, j'ai essayé plusieurs cas mais...
Désolé

Dan
16/03/2011, 18h29
patricktoulon

re

bonjour danbenzi

a tu telecharger mon formulaire dans les contributions

peut etre que tu aura plus de facilité a l'adapter on ton fichier???

au plaisir
19/03/2011, 18h59
danbenzi

Bonjour Patrick,

Oui j'ai bien sur téléchargé ton fichier qui est très intéressant pour me faire avancer. J'ai essayé de voir point par point pourquoi il y a un bug au niveau AddAttachement mais je n'ai pas trouvé la faille.
Je vais plancher de nouveau dessus.

Cordialement
Dan

Bonjour Patrick,

J'ai trouvé avec de l'aide un code qui fonctionne le voici:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
Option Explicit
 
Sub EnvoiMail()
Dim messageHTML As Variant
Dim objMessage As Variant
Dim piece_jointe As Variant
             'crée le fichier à envoyer
Dim chemin, nom As String
chemin = ActiveWorkbook.Path
nom = "Planning.xls"                'Nom du fichier à envoyer
 
ThisWorkbook.ActiveSheet.Copy       'Copie la feuille dans le fichier à envoyer
Sheets(1).DrawingObjects.Delete     'Supprime les boutons
            'Supprime les formules et fixe les valeurs
 
Range("K52:K56").Clear        'Efface les données sous le planning
Range("K61:K64").Clear
Range("C62:C67").Clear
            'Enregistre le fichier à envoyer dans le même répertoire
ActiveWorkbook.SaveAs chemin & "\" & nom
Application.DisplayAlerts = False   'Supprime l'alerte Enregistrer
ActiveWorkbook.Close                'Ferme le fichier
Application.DisplayAlerts = True    'Rétabli les alertes Enregistrer
 
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ée 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 & "\" & "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
        'après l'envoi le fichier créé est supprimé
Kill ActiveWorkbook.Path & "\" & "Planning.xls"
        'si erreur on sort de la procédure
Exit Sub
errorHandler:
        'description de l'erreur survenue
MsgBox Err.Description
End Sub

Mais j'aime bien comprendre et réussir, j'aimerai arriver à faire le code que tu m'as donné plus haut et savoir pourquoi il bug.
Merci de ta patience et de tes conseils.

Dan

bonjour

Alleluyah on y est arrivé enfin ;)

je ne vois pas de différence avec le mien si ce n'est que dans la configuration tu choisi le port "25" ,bien que ca n'a pas trop d'importance sache ue si jamais par hasard ce port est utilisé par un autre processus ça risque de ralentir la donne

sinon pour le reste c'est identique
en plus tu utilise "thisworkbook.path" et blablabla pour le chemin c'est d'ailleurs la que ça coinçait il me semble

je remarque aussi que tu utilise "textbody" et non pas "htmlbody"

et que tes lignes sont sautée par des "vbcrlf" tu vois chez moi ca ne fonctionne pas peut être que nous n'avons pas le même système d'exploitation ou les mêmes mises a jour
enfin
bon travail:ccool: transpirer pour obtenir ce que l'on veut fini toujours par payer

EDIT:

allez juste pour finir de t'achever:mouarf: non je rigole
ton code un peu simplifié:mrgreen:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
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 & "\Planning.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
Sheets(1).DrawingObjects.Delete
'Efface les données sous le planning
Range("K52:K56").Clear
Range("K61:K64").Clear
Range("C62:C67").Clear
'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 = "P1 du " & Range("H4").Value
.From = Range("K52").Value  'adresse mail de l'expéditeur n'est pas obligatoire
.To = Range("K54").Value 'Email du destinataire doit-être correct ici
.Cc = Range("K56").Value    'Email du destinataire en copie
 
'Crée le corps du message avec insertion de sauts de ligne
.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
 
 
 
.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
MsgBox "Le mail a été bien envoyé !" 'Confirmation de l'envoi
        'après l'envoi le fichier créé est supprimé
Kill ActiveWorkbook.Path & "\" & "Planning.xls"
        'si erreur on sort de la procédure
Exit Sub
errorHandler:
        'description de l'erreur survenue
MsgBox Err.Description
End Sub

au plaisir

25/03/2011, 17h39
danbenzi

Bonjour Patrick,

Merci pour ta dernière contribution et surtout pour ton aide et ta patience. Cela faisait longtemps que je chercher, maintenant c'est fait, jusqu'au prochain challenge...

Ton code parfait, il fonctionne très bien mais tu as oublié en fin "End With" c'est l'élève qui dépasse le maitre???:ccool: je pense que tu l'as fait exprès pour voir si je le trouvais!!!:mouarf: je plaisante à mon tour.
Au plaisir
Si je vais à Toulon on se retrouve au marché du Pont du Las ( j'y allais à l'école plus haut) et je te paie un verre. :zoubi:

Dan
25/03/2011, 23h11
patricktoulon

re

bonsoir

oui tu a raison je l'ai oublié mais pas volontairement je m'ensuis rendu compte
apres avoir cliqué je me suis dis il va le voir

pour le verre c'est quand tu veux :mouarf:

ps: a tu essayé ta macro sans l'utilisation du port 25 et avec. regarde un peu le temps gagné sans

allez au plaisir
31/03/2011, 18h58
danbenzi

Bonjour Patrick,

Je viens de faire l'essai et effectivement c'est plus rapide. Sympa l'astuce.:ccool:

Au plaisir

Dan

Voir 40 message(s) de cette discussion en une page