Re : envoi classeur actif + fichier annexe par email
Bonjour oorphee, Hulk, le Forum,
Je me permet de vous mettre ce que j'ai dans mes notes en espérant que cela vous sera utile.
Envoi par OutLook d'un onglet du classeur actif
http://www.excel-downloads.com/forum/110481-envoyer-un-onglet-de-classeur-par-email-en-pj.html
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 'Destinataire(s)
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 'Objet msg.Body = Range("A5").Value & Chr(13) & Chr(13) & Range("A8").Value & Chr(13) & Chr(13) 'Texte et Signature
msg.Attachments.Add Source:=répertoireAppli & "\Resultats.xls" 'Feuille transmise
msg.Send
ActiveCell.Offset(1, 0).Select
Loop
End Sub
'Une autre solution autonome est proposée sur cette page :
http://www.tek-tips.com/faqs.cfm?fid=4334
'Testé sur outlook2000 et 2002 par l'auteur
Sub Mailer()
Sheets("BB Email Data").Select
pathname = [b11].value 'définit le fichier à attacher
dname = [b14].value 'définit la date du fichier
Dim objol As New outlook.Application
Dim objmail As MailItem
Set objol = New outlook.Application
Set objmail = objol.createitem(olmailitem)
With objmail
.To = "whoever" 'entrez ici l'adresse email
.cc = "whoever" 'entrez ici l'adresse du destinaitaire à mettre en copie
.Subject = "Test de mail " & dname 'objet du message (inclut la date de façon dynamique)
.Body = "Veuillez trouver ci-joint le fichier" & _
vbCrLf & "En cas de problème de réception, merci de m'en avertir" & vbCrLf
.NoAging = True
.Attachments.Add pathname 'Ajoute le fichier attaché
.display
End With
Set objmail = Nothing
Set objol = Nothing
SendKeys "%{s}", True 'Envoie le mail sans confirmation
End Sub
JFrancoisQC, Gibelle73, - Ajouté ou modifié le 25/08/2007 (N°1880)
Copier certaines feuilles et les envoyer par mail
Comment recopier dans un nouveau classeur quleques feuilles préalablement sélectionnées et les envoyer par mail au destinataire dont l'adresse est indiquée en A1 ?
La page de garde est prise de toute façon (elle doit être nommée ainsi ou sinon adapter la macro)
Private Function envoiMail()
Dim f As Worksheet
Dim c As Workbook
Dim w As Window
Set w = Windows(1)
ThisWorkbook.Sheets("Page de garde").Copy
Set c = Workbooks.Item(Workbooks.Count)
For Each f In w.SelectedSheets
If f.Name <> "Page de garde" Then
f.Copy after:=Workbooks(c.Name).Sheets("Page de garde")
End If
Next
For Each f In Workbooks(c.Name).Application.Worksheets
f.Protect Password:="blu"
Next
Workbooks(c.Name).SendMail [A1], "Sujet", False
c.Saved = True
c.Close
End Function
Rekam, - Ajouté ou modifié le 09/07/2005 (N°1650)
'Envoyer une feuille excel en tant que corps d'un mail et pas en pièce jointe en exécutant une macro
'réponse de H. S. le lundi 13 décembre 1999 13:06
'newsgroup : microsoft.public.fr.excel
'discussion : Envoi de mail à partir d'Xl
'RAJOUTER UNE REFERENCE AU CONTROLE MAPI
Sub mail_par_vba()
Dim myMessage As New MAPIMessages
Dim mySession As New MAPISession
mySession.UserName = "Hamard Stephane"
mySession.Password = "ZazaAsLesYeuxVertsSelonJ@C"
mySession.SignOn
myMessage.SessionID = mySession.SessionID
myMessage.Compose
myMessage.RecipAddress = "shamard@totoworld.fr"
myMessage.MsgSubject = "Resultat " & Format(Date, "dd/mm/yy")
myMessage.MsgNoteText = "Salut Zaza"
myMessage.AttachmentType = 0
myMessage.AttachmentName = "Fichier test"
myMessage.AttachmentPathName = "c:\perso\ emp\ est.txt"
myMessage.ResolveName
On Error Resume Next
'Je n'arrive pas à intercepter la fermeture de la fenêtre...
'donc j'utilise la gestion d'erreur (pas très bon).
myMessage.Send True
mySession.SignOff
End Sub
Stephane Hamard, - Ajouté ou modifié le 06/08/2004 (N°1468)
