Macro envoie email avec pièce jointe
Harry Baux
Messages postés
18
Statut
Membre
-
Harry Baux Messages postés 18 Statut Membre -
Harry Baux Messages postés 18 Statut Membre -
Bonjour,
J'ai refais une macro à partir d'autres, pour choisis une feuille de mon classeur excel la copier dans un nouveau classeur et envoyer celui ci part email avec un petit message.
Cependant je n'arrive pas à envoyer le classeur en pièce jointe.
Quelqu'un saurait d'ou vient de soucis ?
J'ai beau essayer je ne trouve pas la solution, je dois mal définir ma variable
Merci
J'ai refais une macro à partir d'autres, pour choisis une feuille de mon classeur excel la copier dans un nouveau classeur et envoyer celui ci part email avec un petit message.
Cependant je n'arrive pas à envoyer le classeur en pièce jointe.
Sub ENVOIEMAILRAPPORTtest()
sheets("RAPPORT").Visible = True
Application.DisplayAlerts = False
ThisWorkbook.sheets(12).Copy
With ActiveWorkbook
Set mon_outlook = CreateObject("outlook.application")
Set mon_message = mon_outlook.CreateItem(0)
Set ActiveWorkbook = mon_message.attachments.Add ' (je dois me tromper ici ?)
mon_message.To = "***@gmail.com"
mon_message.Subject = "rapport du " & Format(Date, "dd/mm/yyyy")
mon_message.Body = "Bonjour" & Chr(13) & "Vous trouverez en pièce jointe le rapport " & Chr(13) & "A+"
mon_message.attachments.Add = ActiveWorkbook '(normalement on met ici le chemin de la pj c:)
mon_message.Send
.Close SaveChanges:=False
End With
Application.DisplayAlerts = True
End Sub
Quelqu'un saurait d'ou vient de soucis ?
J'ai beau essayer je ne trouve pas la solution, je dois mal définir ma variable
Set ActiveWorkbook = mon_message.attachments.Add
Merci
3 réponses
-
Bonsoir,
Exemple d'envoi d'une feuille du classeur
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
Jacques Boisgontier -
-
Bonsoir Messieurs,
Merci pour votre aide je vais essayer tout ça
Bonne soirée
