[Excel - Visual] - Envoyer un mail outlook Express en visual Excel

Le
mcog
Bonjour,

Lorsque j'envoie trop de texte dans le body (variable corps), le mail ne se
compose pas.
Si je diminue la variable corps, ca passe.
Voir code ci-dessous

Merci,

Olivier


Private Declare Function ShellExecute _
Lib "shell32.dll" _
Alias "ShellExecuteA" ( _
ByVal hwnd As Long, _
ByVal lpOperation As String, _
ByVal lpFile As String, _
ByVal lpParameters As String, _
ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long

Sub mail()

Dim Destinataire As String
Dim Objet As String
Dim Corps As String

tiers = Sheets("Param").Cells(4, 2)
dossier = Sheets("Param").Cells(5, 2)
date_doc = Sheets("Param").Cells(6, 2)
Désignation = Sheets("Param").Cells(7, 2)
Objet_de_relance = Sheets("Param").Cells(8, 2)
date_offre = Sheets("Param").Cells(9, 2)
modele = Sheets("Param").Cells(10, 2)
date_R1 = Sheets("Param").Cells(11, 2)
date_R2 = Sheets("Param").Cells(12, 2)

For j = 3 To 65500
If Sheets("Tiers").Cells(j, 1) = tiers Then
genre = Sheets("Tiers").Cells(j, 2)
correspondant1 = Sheets("Tiers").Cells(j, 3)
correspondant2 = Sheets("Tiers").Cells(j, 4)
correspondant3 = Sheets("Tiers").Cells(j, 5)
correspondant4 = Sheets("Tiers").Cells(j, 6)
correspondant5 = Sheets("Tiers").Cells(j, 7)
j = 65500

End If
If Sheets("Tiers").Cells(j, 1) = "" And j <> 65500 Then MsgBox
"Compte tiers : " + tiers + " non renseigné": j = 65500

Next j

Destinataire1 = correspondant1 + ";" + correspondant2
copie = correspondant3 + ";" + correspondant4 + ";" + correspondant5
Objet = dossier + " - " + Désignation + " - " + Objet_de_relance

Corps = genre + "%0D%0A" + "%0D%0A" +
"blablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablabla"
+ Format(Str(date_doc)) +
"blablablablablablablablablablablablablablablablablablablablablablablablablabla"
+ dossier + "blablablablablablablablablabla" + Format(Str(date_offre)) + ",
blablablablablablablablablablablablablablablablablablablabla." + "%0D%0A" +
"blablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablabla."+
"%0D%0A" +
"blablablablablablablablablablablablablablablablablablablablablablablablablablablabla+
"%0D%0A" + " Dans l'attente de vos nouvelles, veuillez accepter, Messieurs,
nos sincères salutations." + "%0D%0A" + "Personne à contacter pour réponse
:" + "%0D%0A" + "blablablablablablablablablabla" + "%0D%0A" +
"03.26.48.46.11" + "%0D%0A" + "toto@wanadoo.fr"

ShellExecute 0, _
"Open", "mailto:" & Destinataire1 & _
"?subject=" & Objet & _
"&CC=" & copie & _
"&Body=" & Corps _
, "", _
0, _
3

End Sub
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
Pascal
Le #4265561
Bonsoir,
J'ai eu le même probléme résolu avec l'aide de JB et d'autres contributeurs
de cette manière

Sub ole()
Dim oApp As Word.Application, doc As Word.Document
Sheets("Env").Select
Range("B2").Select ' premier client
Do While Not IsEmpty(ActiveCell)
On Error Resume Next
nf = ThisWorkbook.Path & "Corps_mail.doc" 'Choix du corps du mail et
bien sur à adapter
Set oApp = CreateObject("Word.Application")
oApp.Visible = True
Set doc = oApp.Documents.Open(nf)
If Err <> 0 Then
MsgBox "Le fichier publi.doc doit être dans " & ThisWorkbook.Path
Exit Sub
End If
On Error GoTo 0 ' Annule la gestion d'erreur
'--
Société = ActiveCell.Value 'ici B2
Email = ActiveCell.Offset(0, 8).Value
Corps = doc.Content.Text 'Récupére le doc choisi plus haut pour
l'insérer en corps de mail
'--
nom_doc = ThisWorkbook.Path & "" & Société & ".doc"
doc.SaveAs nom_doc
oApp.Quit
'------------------------ envoi par mail
Dim olapp As Outlook.Application
Dim Msg As MailItem
Set olapp = New Outlook.Application
Set Msg = olapp.CreateItem(olMailItem)
Msg.To = Email
Msg.Subject = Sujet
Msg.Body = Corps
Msg.Attachments.Add Source:="C:TotolToto_1doc" 'Insertion de la pièce
jointe
Msg.Send
Set olapp = Nothing
ActiveCell.Offset(1, 0).Select ' Client suivant
Loop
Set oApp = Nothing
MsgBox "Message envoyé"
End Sub


"mcog" 460c0b3f$0$27408$
Bonjour,

Lorsque j'envoie trop de texte dans le body (variable corps), le mail ne
se compose pas.
Si je diminue la variable corps, ca passe.
Voir code ci-dessous

Merci,

Olivier


Private Declare Function ShellExecute _
Lib "shell32.dll" _
Alias "ShellExecuteA" ( _
ByVal hwnd As Long, _
ByVal lpOperation As String, _
ByVal lpFile As String, _
ByVal lpParameters As String, _
ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long

Sub mail()

Dim Destinataire As String
Dim Objet As String
Dim Corps As String

tiers = Sheets("Param").Cells(4, 2)
dossier = Sheets("Param").Cells(5, 2)
date_doc = Sheets("Param").Cells(6, 2)
Désignation = Sheets("Param").Cells(7, 2)
Objet_de_relance = Sheets("Param").Cells(8, 2)
date_offre = Sheets("Param").Cells(9, 2)
modele = Sheets("Param").Cells(10, 2)
date_R1 = Sheets("Param").Cells(11, 2)
date_R2 = Sheets("Param").Cells(12, 2)

For j = 3 To 65500
If Sheets("Tiers").Cells(j, 1) = tiers Then
genre = Sheets("Tiers").Cells(j, 2)
correspondant1 = Sheets("Tiers").Cells(j, 3)
correspondant2 = Sheets("Tiers").Cells(j, 4)
correspondant3 = Sheets("Tiers").Cells(j, 5)
correspondant4 = Sheets("Tiers").Cells(j, 6)
correspondant5 = Sheets("Tiers").Cells(j, 7)
j = 65500

End If
If Sheets("Tiers").Cells(j, 1) = "" And j <> 65500 Then MsgBox
"Compte tiers : " + tiers + " non renseigné": j = 65500

Next j

Destinataire1 = correspondant1 + ";" + correspondant2
copie = correspondant3 + ";" + correspondant4 + ";" + correspondant5
Objet = dossier + " - " + Désignation + " - " + Objet_de_relance

Corps = genre + "%0D%0A" + "%0D%0A" +
"blablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablabla"
+ Format(Str(date_doc)) +
"blablablablablablablablablablablablablablablablablablablablablablablablablabla"
+ dossier + "blablablablablablablablablabla" + Format(Str(date_offre)) +
", blablablablablablablablablablablablablablablablablablablabla." +
"%0D%0A" +
"blablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablabla."+
"%0D%0A" +
"blablablablablablablablablablablablablablablablablablablablablablablablablablablabla+
"%0D%0A" + " Dans l'attente de vos nouvelles, veuillez accepter,
Messieurs, nos sincères salutations." + "%0D%0A" + "Personne à contacter
pour réponse :" + "%0D%0A" + "blablablablablablablablablabla" + "%0D%0A" +
"03.26.48.46.11" + "%0D%0A" + ""

ShellExecute 0, _
"Open", "mailto:" & Destinataire1 & _
"?subject=" & Objet & _
"&CC=" & copie & _
"&Body=" & Corps _
, "", _
0, _
3

End Sub







---
Antivirus avast! : message Entrant sain.
Base de donnees virale (VPS) : 000728-2, 28/03/2007
Analyse le : 29/03/2007 21:41:32
avast! - copyright (c) 1988-2007 ALWIL Software.
http://www.avast.com








---
Antivirus avast! : message Sortant sain.
Base de donnees virale (VPS) : 000728-2, 28/03/2007
Analyse le : 29/03/2007 21:46:25
avast! - copyright (c) 1988-2007 ALWIL Software.
http://www.avast.com

mcog
Le #4262441
Bonsoir,
J'ai eu le même probléme résolu avec l'aide de JB et d'autres
contributeurs de cette manière

Sub ole()
Dim oApp As Word.Application, doc As Word.Document
Sheets("Env").Select
Range("B2").Select ' premier client
Do While Not IsEmpty(ActiveCell)
On Error Resume Next
nf = ThisWorkbook.Path & "Corps_mail.doc" 'Choix du corps du mail et
bien sur à adapter
Set oApp = CreateObject("Word.Application")
oApp.Visible = True
Set doc = oApp.Documents.Open(nf)
If Err <> 0 Then
MsgBox "Le fichier publi.doc doit être dans " & ThisWorkbook.Path
Exit Sub
End If
On Error GoTo 0 ' Annule la gestion d'erreur
'--
Société = ActiveCell.Value 'ici B2
Email = ActiveCell.Offset(0, 8).Value
Corps = doc.Content.Text 'Récupére le doc choisi plus haut pour
l'insérer en corps de mail
'--
nom_doc = ThisWorkbook.Path & "" & Société & ".doc"
doc.SaveAs nom_doc
oApp.Quit
'------------------------ envoi par mail
Dim olapp As Outlook.Application
Dim Msg As MailItem
Set olapp = New Outlook.Application
Set Msg = olapp.CreateItem(olMailItem)
Msg.To = Email
Msg.Subject = Sujet
Msg.Body = Corps
Msg.Attachments.Add Source:="C:TotolToto_1doc" 'Insertion de la pièce
jointe
Msg.Send
Set olapp = Nothing
ActiveCell.Offset(1, 0).Select ' Client suivant
Loop
Set oApp = Nothing
MsgBox "Message envoyé"
End Sub


"mcog" 460c0b3f$0$27408$
Bonjour,

Lorsque j'envoie trop de texte dans le body (variable corps), le mail ne
se compose pas.
Si je diminue la variable corps, ca passe.
Voir code ci-dessous

Merci,

Olivier


Private Declare Function ShellExecute _
Lib "shell32.dll" _
Alias "ShellExecuteA" ( _
ByVal hwnd As Long, _
ByVal lpOperation As String, _
ByVal lpFile As String, _
ByVal lpParameters As String, _
ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long

Sub mail()

Dim Destinataire As String
Dim Objet As String
Dim Corps As String

tiers = Sheets("Param").Cells(4, 2)
dossier = Sheets("Param").Cells(5, 2)
date_doc = Sheets("Param").Cells(6, 2)
Désignation = Sheets("Param").Cells(7, 2)
Objet_de_relance = Sheets("Param").Cells(8, 2)
date_offre = Sheets("Param").Cells(9, 2)
modele = Sheets("Param").Cells(10, 2)
date_R1 = Sheets("Param").Cells(11, 2)
date_R2 = Sheets("Param").Cells(12, 2)

For j = 3 To 65500
If Sheets("Tiers").Cells(j, 1) = tiers Then
genre = Sheets("Tiers").Cells(j, 2)
correspondant1 = Sheets("Tiers").Cells(j, 3)
correspondant2 = Sheets("Tiers").Cells(j, 4)
correspondant3 = Sheets("Tiers").Cells(j, 5)
correspondant4 = Sheets("Tiers").Cells(j, 6)
correspondant5 = Sheets("Tiers").Cells(j, 7)
j = 65500

End If
If Sheets("Tiers").Cells(j, 1) = "" And j <> 65500 Then MsgBox
"Compte tiers : " + tiers + " non renseigné": j = 65500

Next j

Destinataire1 = correspondant1 + ";" + correspondant2
copie = correspondant3 + ";" + correspondant4 + ";" + correspondant5
Objet = dossier + " - " + Désignation + " - " + Objet_de_relance

Corps = genre + "%0D%0A" + "%0D%0A" +
"blablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablabla"
+ Format(Str(date_doc)) +
"blablablablablablablablablablablablablablablablablablablablablablablablablabla"
+ dossier + "blablablablablablablablablabla" + Format(Str(date_offre)) +
", blablablablablablablablablablablablablablablablablablablabla." +
"%0D%0A" +
"blablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablablabla."+
"%0D%0A" +
"blablablablablablablablablablablablablablablablablablablablablablablablablablablabla+
"%0D%0A" + " Dans l'attente de vos nouvelles, veuillez accepter,
Messieurs, nos sincères salutations." + "%0D%0A" + "Personne à contacter
pour réponse :" + "%0D%0A" + "blablablablablablablablablabla" + "%0D%0A"
+ "03.26.48.46.11" + "%0D%0A" + ""

ShellExecute 0, _
"Open", "mailto:" & Destinataire1 & _
"?subject=" & Objet & _
"&CC=" & copie & _
"&Body=" & Corps _
, "", _
0, _
3

End Sub



Merci beaucoup,

Ca marche pas mal, mais ca fait sauter tous les retours chariots, malgrés
qu'il y en ai dans le fichier modele...

Combine ?

Merci,

Olivier


Publicité
Poster une réponse
Anonyme