Bonjour à Toute et à tous,
je souhaite adapter quelques codes pour envoyer des mails avec ou sans
pièces jointes depuis un onglet.
J'ai récupéré quelques codes notamment un de JB, qui me va bien mais qui ne
fonctionne que sur outlook
Or ce fichier sera utilisé par kek personnes qui utilisent windows mail
KEKUN voit-y comment modifier la syntaxe pour qu'il puisse être utilisé sur
windows mail ( et , si possibeule, sur tous types d'application de mail)?
Sub envoi_Feuille()
répertoireAppli = ActiveWorkbook.Path
Sheets("résultats").Copy
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs répertoireAppli & "Resultats.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 & "Resultats.xls"
msg.Send
ActiveCell.Offset(1, 0).Select
Loop
End Sub
Merci de toutes façons
Gilles
Bonjour à Toute et à tous,
je souhaite adapter quelques codes pour envoyer des mails avec ou sans
pièces jointes depuis un onglet.
J'ai récupéré quelques codes notamment un de JB, qui me va bien mais qui ne
fonctionne que sur outlook
Or ce fichier sera utilisé par kek personnes qui utilisent windows mail
KEKUN voit-y comment modifier la syntaxe pour qu'il puisse être utilisé sur
windows mail ( et , si possibeule, sur tous types d'application de mail)?
Sub envoi_Feuille()
répertoireAppli = ActiveWorkbook.Path
Sheets("résultats").Copy
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs répertoireAppli & "Resultats.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 & "Resultats.xls"
msg.Send
ActiveCell.Offset(1, 0).Select
Loop
End Sub
Merci de toutes façons
Gilles
Bonjour à Toute et à tous,
je souhaite adapter quelques codes pour envoyer des mails avec ou sans
pièces jointes depuis un onglet.
J'ai récupéré quelques codes notamment un de JB, qui me va bien mais qui ne
fonctionne que sur outlook
Or ce fichier sera utilisé par kek personnes qui utilisent windows mail
KEKUN voit-y comment modifier la syntaxe pour qu'il puisse être utilisé sur
windows mail ( et , si possibeule, sur tous types d'application de mail)?
Sub envoi_Feuille()
répertoireAppli = ActiveWorkbook.Path
Sheets("résultats").Copy
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs répertoireAppli & "Resultats.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 & "Resultats.xls"
msg.Send
ActiveCell.Offset(1, 0).Select
Loop
End Sub
Merci de toutes façons
Gilles
Bonjour.
Je n'ai pas la possibilité de tester le cas Windows Mail. Exécute la
macro "Mail" qui fera appel soit à "Envoi_Feuille", soit à "CDO_Mail"
selon que l'utilisateur dispose ou non d'Outlook. La macro CDO_Mail est
inspirée d'une macro de Ron de Bruin
(http://www.rondebruin.nl/cdo.htm). Tu pourrais te contenter de la
macro "CDO_Mail"; son point faible est que, pour les utilisateurs
d'Outlook, il faut coder l'username et le mot de passe de chaque
utilisateur.
Sub Mail()
On Error Resume Next
Set olapp = CreateObject("Outlook.Application")
If Err.Number <> 0 Then
CDO_Mail
Else
envoi_Feuille
End If
On Error GoTo 0
End Sub
Sub envoi_Feuille()
répertoireAppli = ActiveWorkbook.Path
Sheets("résultats").Copy
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs répertoireAppli & "Resultats.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 & "Resultats.xls"
msg.Send
ActiveCell.Offset(1, 0).Select
Loop
End Sub
Sub CDO_Mail()
Dim iMsg As Object
Dim iConf As Object
Dim strbody As String
Dim Flds As Variant
répertoireAppli = ActiveWorkbook.Path
Sheets("résultats").Copy
ActiveWorkbook.SaveAs répertoireAppli & "Resultats.xls"
ActiveWindow.Close
'--- Envoi par mail
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
iConf.Load -1 ' CDO Source Defaults
Set Flds = iConf.Fields
With Flds
..Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
..Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") _
= "smtp.free.fr" 'Mettre ici ton serveur SMTP
'.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport")
= 25
'.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate")
= 1
'.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") =
""
'.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") =
""
'.Update
End With
Sheets("destinataires").Select
Range("A11").Select
Do While Not IsEmpty(ActiveCell)
With iMsg
Set .Configuration = iConf
.To = ActiveCell.Value
.CC = ""
.BCC = ""
.From = """Ron"" "
.Subject = Range("A2").Value
.TextBody = Range("A5").Value & Chr(13) & Chr(13) &
Range("A8").Value & _
Chr(13) & Chr(13)
.AddAttachment répertoireAppli & "Resultats.xls"
.Send
End With
ActiveCell.Offset(1, 0).Select
Loop
End Sub
Cordialement.
Daniel
> Bonjour à Toute et à tous,
> je souhaite adapter quelques codes pour envoyer des mails avec ou sans
> pièces jointes depuis un onglet.
> J'ai récupéré quelques codes notamment un de JB, qui me va bien mais qui ne
> fonctionne que sur outlook
> Or ce fichier sera utilisé par kek personnes qui utilisent windows mail
> KEKUN voit-y comment modifier la syntaxe pour qu'il puisse être utilisé sur
> windows mail ( et , si possibeule, sur tous types d'application de mail)?
>
> Sub envoi_Feuille()
> répertoireAppli = ActiveWorkbook.Path
> Sheets("résultats").Copy
> Application.DisplayAlerts = False
> ActiveWorkbook.SaveAs répertoireAppli & "Resultats.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 & "Resultats.xls"
> msg.Send
> ActiveCell.Offset(1, 0).Select
> Loop
> End Sub
>
> Merci de toutes façons
> Gilles
Bonjour.
Je n'ai pas la possibilité de tester le cas Windows Mail. Exécute la
macro "Mail" qui fera appel soit à "Envoi_Feuille", soit à "CDO_Mail"
selon que l'utilisateur dispose ou non d'Outlook. La macro CDO_Mail est
inspirée d'une macro de Ron de Bruin
(http://www.rondebruin.nl/cdo.htm). Tu pourrais te contenter de la
macro "CDO_Mail"; son point faible est que, pour les utilisateurs
d'Outlook, il faut coder l'username et le mot de passe de chaque
utilisateur.
Sub Mail()
On Error Resume Next
Set olapp = CreateObject("Outlook.Application")
If Err.Number <> 0 Then
CDO_Mail
Else
envoi_Feuille
End If
On Error GoTo 0
End Sub
Sub envoi_Feuille()
répertoireAppli = ActiveWorkbook.Path
Sheets("résultats").Copy
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs répertoireAppli & "Resultats.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 & "Resultats.xls"
msg.Send
ActiveCell.Offset(1, 0).Select
Loop
End Sub
Sub CDO_Mail()
Dim iMsg As Object
Dim iConf As Object
Dim strbody As String
Dim Flds As Variant
répertoireAppli = ActiveWorkbook.Path
Sheets("résultats").Copy
ActiveWorkbook.SaveAs répertoireAppli & "Resultats.xls"
ActiveWindow.Close
'--- Envoi par mail
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
iConf.Load -1 ' CDO Source Defaults
Set Flds = iConf.Fields
With Flds
..Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
..Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") _
= "smtp.free.fr" 'Mettre ici ton serveur SMTP
'.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport")
= 25
'.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate")
= 1
'.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") =
""
'.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") =
""
'.Update
End With
Sheets("destinataires").Select
Range("A11").Select
Do While Not IsEmpty(ActiveCell)
With iMsg
Set .Configuration = iConf
.To = ActiveCell.Value
.CC = ""
.BCC = ""
.From = """Ron"" <ron@something.nl>"
.Subject = Range("A2").Value
.TextBody = Range("A5").Value & Chr(13) & Chr(13) &
Range("A8").Value & _
Chr(13) & Chr(13)
.AddAttachment répertoireAppli & "Resultats.xls"
.Send
End With
ActiveCell.Offset(1, 0).Select
Loop
End Sub
Cordialement.
Daniel
> Bonjour à Toute et à tous,
> je souhaite adapter quelques codes pour envoyer des mails avec ou sans
> pièces jointes depuis un onglet.
> J'ai récupéré quelques codes notamment un de JB, qui me va bien mais qui ne
> fonctionne que sur outlook
> Or ce fichier sera utilisé par kek personnes qui utilisent windows mail
> KEKUN voit-y comment modifier la syntaxe pour qu'il puisse être utilisé sur
> windows mail ( et , si possibeule, sur tous types d'application de mail)?
>
> Sub envoi_Feuille()
> répertoireAppli = ActiveWorkbook.Path
> Sheets("résultats").Copy
> Application.DisplayAlerts = False
> ActiveWorkbook.SaveAs répertoireAppli & "Resultats.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 & "Resultats.xls"
> msg.Send
> ActiveCell.Offset(1, 0).Select
> Loop
> End Sub
>
> Merci de toutes façons
> Gilles
Bonjour.
Je n'ai pas la possibilité de tester le cas Windows Mail. Exécute la
macro "Mail" qui fera appel soit à "Envoi_Feuille", soit à "CDO_Mail"
selon que l'utilisateur dispose ou non d'Outlook. La macro CDO_Mail est
inspirée d'une macro de Ron de Bruin
(http://www.rondebruin.nl/cdo.htm). Tu pourrais te contenter de la
macro "CDO_Mail"; son point faible est que, pour les utilisateurs
d'Outlook, il faut coder l'username et le mot de passe de chaque
utilisateur.
Sub Mail()
On Error Resume Next
Set olapp = CreateObject("Outlook.Application")
If Err.Number <> 0 Then
CDO_Mail
Else
envoi_Feuille
End If
On Error GoTo 0
End Sub
Sub envoi_Feuille()
répertoireAppli = ActiveWorkbook.Path
Sheets("résultats").Copy
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs répertoireAppli & "Resultats.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 & "Resultats.xls"
msg.Send
ActiveCell.Offset(1, 0).Select
Loop
End Sub
Sub CDO_Mail()
Dim iMsg As Object
Dim iConf As Object
Dim strbody As String
Dim Flds As Variant
répertoireAppli = ActiveWorkbook.Path
Sheets("résultats").Copy
ActiveWorkbook.SaveAs répertoireAppli & "Resultats.xls"
ActiveWindow.Close
'--- Envoi par mail
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
iConf.Load -1 ' CDO Source Defaults
Set Flds = iConf.Fields
With Flds
..Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
..Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") _
= "smtp.free.fr" 'Mettre ici ton serveur SMTP
'.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport")
= 25
'.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate")
= 1
'.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") =
""
'.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") =
""
'.Update
End With
Sheets("destinataires").Select
Range("A11").Select
Do While Not IsEmpty(ActiveCell)
With iMsg
Set .Configuration = iConf
.To = ActiveCell.Value
.CC = ""
.BCC = ""
.From = """Ron"" "
.Subject = Range("A2").Value
.TextBody = Range("A5").Value & Chr(13) & Chr(13) &
Range("A8").Value & _
Chr(13) & Chr(13)
.AddAttachment répertoireAppli & "Resultats.xls"
.Send
End With
ActiveCell.Offset(1, 0).Select
Loop
End Sub
Cordialement.
Daniel
> Bonjour à Toute et à tous,
> je souhaite adapter quelques codes pour envoyer des mails avec ou sans
> pièces jointes depuis un onglet.
> J'ai récupéré quelques codes notamment un de JB, qui me va bien mais qui ne
> fonctionne que sur outlook
> Or ce fichier sera utilisé par kek personnes qui utilisent windows mail
> KEKUN voit-y comment modifier la syntaxe pour qu'il puisse être utilisé sur
> windows mail ( et , si possibeule, sur tous types d'application de mail)?
>
> Sub envoi_Feuille()
> répertoireAppli = ActiveWorkbook.Path
> Sheets("résultats").Copy
> Application.DisplayAlerts = False
> ActiveWorkbook.SaveAs répertoireAppli & "Resultats.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 & "Resultats.xls"
> msg.Send
> ActiveCell.Offset(1, 0).Select
> Loop
> End Sub
>
> Merci de toutes façons
> Gilles
Bonjour à Toute et à tous,
je souhaite adapter quelques codes pour envoyer des mails avec ou sans
pièces jointes depuis un onglet.
J'ai récupéré quelques codes notamment un de JB, qui me va bien mais qui ne
fonctionne que sur outlook
Or ce fichier sera utilisé par kek personnes qui utilisent windows mail
KEKUN voit-y comment modifier la syntaxe pour qu'il puisse être utilisé sur
windows mail ( et , si possibeule, sur tous types d'application de mail)?
Sub envoi_Feuille()
répertoireAppli = ActiveWorkbook.Path
Sheets("résultats").Copy
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs répertoireAppli & "Resultats.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 & "Resultats.xls"
msg.Send
ActiveCell.Offset(1, 0).Select
Loop
End Sub
Merci de toutes façons
Gilles
--
gilles72
Bonjour à Toute et à tous,
je souhaite adapter quelques codes pour envoyer des mails avec ou sans
pièces jointes depuis un onglet.
J'ai récupéré quelques codes notamment un de JB, qui me va bien mais qui ne
fonctionne que sur outlook
Or ce fichier sera utilisé par kek personnes qui utilisent windows mail
KEKUN voit-y comment modifier la syntaxe pour qu'il puisse être utilisé sur
windows mail ( et , si possibeule, sur tous types d'application de mail)?
Sub envoi_Feuille()
répertoireAppli = ActiveWorkbook.Path
Sheets("résultats").Copy
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs répertoireAppli & "Resultats.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 & "Resultats.xls"
msg.Send
ActiveCell.Offset(1, 0).Select
Loop
End Sub
Merci de toutes façons
Gilles
--
gilles72
Bonjour à Toute et à tous,
je souhaite adapter quelques codes pour envoyer des mails avec ou sans
pièces jointes depuis un onglet.
J'ai récupéré quelques codes notamment un de JB, qui me va bien mais qui ne
fonctionne que sur outlook
Or ce fichier sera utilisé par kek personnes qui utilisent windows mail
KEKUN voit-y comment modifier la syntaxe pour qu'il puisse être utilisé sur
windows mail ( et , si possibeule, sur tous types d'application de mail)?
Sub envoi_Feuille()
répertoireAppli = ActiveWorkbook.Path
Sheets("résultats").Copy
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs répertoireAppli & "Resultats.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 & "Resultats.xls"
msg.Send
ActiveCell.Offset(1, 0).Select
Loop
End Sub
Merci de toutes façons
Gilles
--
gilles72
Daniel
merci de ton aide et excuses le retard à la réponse (pb de PC)
je doute que tu reviennes sur ce fil un peu ancien, mais àa tout hasard...
j'ai essayé les code mais sans succès
je n'active pas du tout windows mail--
Merci malgré tout
gilles72
"gilles" a écrit :Bonjour à Toute et à tous,
je souhaite adapter quelques codes pour envoyer des mails avec ou sans
pièces jointes depuis un onglet.
J'ai récupéré quelques codes notamment un de JB, qui me va bien mais qui ne
fonctionne que sur outlook
Or ce fichier sera utilisé par kek personnes qui utilisent windows mail
KEKUN voit-y comment modifier la syntaxe pour qu'il puisse être utilisé sur
windows mail ( et , si possibeule, sur tous types d'application de mail)?
Sub envoi_Feuille()
répertoireAppli = ActiveWorkbook.Path
Sheets("résultats").Copy
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs répertoireAppli & "Resultats.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 & "Resultats.xls"
msg.Send
ActiveCell.Offset(1, 0).Select
Loop
End Sub
Merci de toutes façons
Gilles
--
gilles72
Daniel
merci de ton aide et excuses le retard à la réponse (pb de PC)
je doute que tu reviennes sur ce fil un peu ancien, mais àa tout hasard...
j'ai essayé les code mais sans succès
je n'active pas du tout windows mail--
Merci malgré tout
gilles72
"gilles" a écrit :
Bonjour à Toute et à tous,
je souhaite adapter quelques codes pour envoyer des mails avec ou sans
pièces jointes depuis un onglet.
J'ai récupéré quelques codes notamment un de JB, qui me va bien mais qui ne
fonctionne que sur outlook
Or ce fichier sera utilisé par kek personnes qui utilisent windows mail
KEKUN voit-y comment modifier la syntaxe pour qu'il puisse être utilisé sur
windows mail ( et , si possibeule, sur tous types d'application de mail)?
Sub envoi_Feuille()
répertoireAppli = ActiveWorkbook.Path
Sheets("résultats").Copy
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs répertoireAppli & "Resultats.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 & "Resultats.xls"
msg.Send
ActiveCell.Offset(1, 0).Select
Loop
End Sub
Merci de toutes façons
Gilles
--
gilles72
Daniel
merci de ton aide et excuses le retard à la réponse (pb de PC)
je doute que tu reviennes sur ce fil un peu ancien, mais àa tout hasard...
j'ai essayé les code mais sans succès
je n'active pas du tout windows mail--
Merci malgré tout
gilles72
"gilles" a écrit :Bonjour à Toute et à tous,
je souhaite adapter quelques codes pour envoyer des mails avec ou sans
pièces jointes depuis un onglet.
J'ai récupéré quelques codes notamment un de JB, qui me va bien mais qui ne
fonctionne que sur outlook
Or ce fichier sera utilisé par kek personnes qui utilisent windows mail
KEKUN voit-y comment modifier la syntaxe pour qu'il puisse être utilisé sur
windows mail ( et , si possibeule, sur tous types d'application de mail)?
Sub envoi_Feuille()
répertoireAppli = ActiveWorkbook.Path
Sheets("résultats").Copy
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs répertoireAppli & "Resultats.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 & "Resultats.xls"
msg.Send
ActiveCell.Offset(1, 0).Select
Loop
End Sub
Merci de toutes façons
Gilles
--
gilles72