MASSJIPE
XLDnaute Impliqué
Bonjour
Y a t'il un moyen de contourner le message lors d'un envoi par mail
d'un classeur Voir photo
SI X destinataires à chaque fois il dire oui
Merci
Sub envoi_Feuille()
répertoireAppli = ActiveWorkbook.Path ' Penser à Outils/Références Outlook
Sheets("ROVSTR").Copy ' crée un classeur avec la feuille résultats
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs répertoireAppli & "\ROVSTR.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 & "\ROVSTR.xls"
msg.Send
ActiveCell.Offset(1, 0).Select
Loop
End Sub
Sub lit_messagerie()
Dim olapp As Outlook.Application 'penser à Outils/Références Outlook
Dim olns As Outlook.NameSpace
Dim olmf As Outlook.MAPIFolder
Dim obj As Object
Set olapp = New Outlook.Application
Set olns = olapp.GetNamespace("mapi")
Set olmf = olns.GetDefaultFolder(olFolderInbox)
For Each obj In olmf.Items
MsgBox obj.Subject
Next
End Sub
Y a t'il un moyen de contourner le message lors d'un envoi par mail
d'un classeur Voir photo
SI X destinataires à chaque fois il dire oui
Merci
Sub envoi_Feuille()
répertoireAppli = ActiveWorkbook.Path ' Penser à Outils/Références Outlook
Sheets("ROVSTR").Copy ' crée un classeur avec la feuille résultats
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs répertoireAppli & "\ROVSTR.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 & "\ROVSTR.xls"
msg.Send
ActiveCell.Offset(1, 0).Select
Loop
End Sub
Sub lit_messagerie()
Dim olapp As Outlook.Application 'penser à Outils/Références Outlook
Dim olns As Outlook.NameSpace
Dim olmf As Outlook.MAPIFolder
Dim obj As Object
Set olapp = New Outlook.Application
Set olns = olapp.GetNamespace("mapi")
Set olmf = olns.GetDefaultFolder(olFolderInbox)
For Each obj In olmf.Items
MsgBox obj.Subject
Next
End Sub