Accueil

Envoi par OutLook d'un onglet du classeur actif

Dans Outils/Références cocher OutLook

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