lancer des mails sur outlook ou windows mail

Le
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
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
Daniel.C
Le #18224751
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


gilles
Le #18254151
Merci Daniel
excuse la lenteur de ma réponse
je n'arrivais pas à me connecter ces jours-ci
je regarde tout ça
merci encore
--
gilles72


"Daniel.C" a écrit :

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





gilles
Le #18310201
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.C
Le #18314311
Bonjour.
Essaie la seule macro "CDO_Mail" sur un ordi disposant de windows mail
(et ne disposant pas d'Outlook).
As-tu un message d'erreur, ou ne se passe-t-il rien ?
Daniel

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




Publicité
Poster une réponse
Anonyme