Inserer une feuille dans le corps d'un mail
Bonjour,
Je débute en VBA et j'ai besoin d'envoyer une feuille de calcul par mail à une liste de diffusion.
Ce que je parvient à faire:
un bouton macro pour créer, dans un second classeur, un masque qui se remplit avec les données du premier classeur.
Un bouton macro (dans le second classeur), qui envoie par mail ce classeur en Pj. L'objet du message se remplit par des champs du classeur. Les classeurs se ferment et se sauvegardent. Les messages d'avertissement n'apparaissent pas.
Problème : le destinataire reçoit le classeur avec les macro et lors de l'ouverture, on lui demande de les activer ou non...
Ce point est complètement inutile pour le destinataire qui n'a pas besoin de traiter les informations mais juste d'en prendre connaissance et éventuellement de faire suivre ce mail à d'autres personnes.
Ce que je veux faire:
Créer un bouton (dans le second classeur), qui insère une zone prédéfinie de la feuille dans le corps d'un mail soit en HTLM ou autres...
C'est pour mon boulot donc j'utilise excel 2003 et outlook 2003.
Merci à vous
Benoît
Bonjour,
C'est certainement parce que tu envoies le classeur entier plutôt que la feuille en question.
Pour le code, vois ce lien et prends le fichier version 4 --> https://forum.excel-pratique.com/excel/insertion-automatique-d-adresses-electroniques-t16935-10.html. Il faudra certainement adapter le code en fonction de ton fichier contenant la feuille à envoyer.
Mets ton fichier en ligne si tu n'arrives pas à adapter le code proposé dans ce fichier.
Amicalement
Merci Dan,
voila ou j'en suis:
Private Sub corps_click()
Dim ol As New Outlook.Application
Dim olmail As MailItem
Dim CurrFile As String
Set ol = New Outlook.Application
Set olmail = ol.CreateItem(olMailItem)
With olmail
.To = aaa@gmail.com"
.Subject = Range("b7").Value & " " & Range("C16").Value & " " & Range("E20").Value
.Body = Range("a1", "g32").Value
.Send
End With
ThisWorkbook.Save
ThisWorkbook.Close
End Sub
Là où ça coince, c'est dans le corps du mail.
Je voudrais intéger soit mon tableau soit les informations contenues avec (si possible) une mise en forme.
et là, je cale...
Meknès
Bon, j'avance,
ma macro crée un fichier pdf dans un répertoire.
D'autres fichiers PDF seront présents.
Je désire inclure à cette macro l'envoi par mail de ce fichier nouvellement créé.
Je pense que je devrais y arriver avec les différentes contributions, mais pour gagner du temps, un coup de pouce serait le bienvenu.
Merci
-- 01 Sep 2010, 20:51 --
J'ai reussi! voila le code qui me permet de:
Convertir une selection d'un fichier XLS en PDF avec le titre de mon choix
de créer deux fichiers PDF, l'un pour archivage, l'autre pour envoi à un ou plusieurs destinataires...
De supprimer l'une des copies après envoi.
de fermer le fichier, etc...
Je suis très content sauf que chez moi, c'est OS win 7, office 2010 et PDFCreator 1.0.2 et cela marche parfaitement... et à mon boulot c'est Win XP, office 2003 ou 2007 et PDFCreator 0.9.3 et mon code génère des erreurs dont la 75 dans PDF Creator.
Je continue d'avancer, voici déjà un code qui marche chez moi:
Private Sub envoi_click()
' dans references (VBA) il faut cocher pdfcreator et outlook library et microsoft scripting runtime
'creation du pdf à envoyer
Set pdfjob = CreateObject("PDFCreator.clsPDFCreator")
NomExcel = ThisWorkbook.Name
jour = Format(Now(), "ddmmyyyy")
NomPdf = Left(jour & "_" & Range("A6").Value & "_" & Range("C16").Value & "_" & Range("E20").Value, Len(jour & "_" & Range("A6").Value & " " & Range("C16").Value & " " & Range("E20").Value) - 0) & ".pdf"
With pdfjob
If .cStart("/NoProcessingAtStartup") = False Then
MsgBox "Can't initialize PDFCreator.", vbCritical + vbOKOnly, "PrtPDFCreator"
Exit Sub
End If
.cOption("UseAutosave") = 1
.cOption("UseAutisaveDirectory") = 1
.cOption("AutosaveDirectory") = "f:\1_excel\"
.cOption("AutosaveFilename") = NomPdf
.cOption("AutosaveFormat") = 0
.cClearCache
End With
Range("a1", "g32").PrintOut copies:=1, ActivePrinter:="PDFCreator"
Do Until pdfjob.cCountOfPrintjobs = 1
DoEvents
Loop
pdfjob.cPrinterStop = False
Do Until pdfjob.cCountOfPrintjobs = 0
DoEvents
Loop
With pdfjob
.cDefaultPrinter = DefaultPrinter
.cClearCache
.cClose
End With
Set pdfjob = Nothing
'creation du pdf à sauvegarder
Set pdfjob = CreateObject("PDFCreator.clsPDFCreator")
NomExcel = ThisWorkbook.Name
jour = Format(Now(), "ddmmyyyy")
NomPdf = Left(jour & "_" & Range("A6").Value & "_" & Range("C16").Value & "_" & Range("E20").Value, Len(jour & "_" & Range("A6").Value & " " & Range("C16").Value & " " & Range("E20").Value) - 0) & ".pdf"
With pdfjob
If .cStart("/NoProcessingAtStartup") = False Then
MsgBox "Can't initialize PDFCreator.", vbCritical + vbOKOnly, "PrtPDFCreator"
Exit Sub
End If
.cOption("UseAutosave") = 1
.cOption("UseAutisaveDirectory") = 1
.cOption("AutosaveDirectory") = "f:\1_excel\archive\"
.cOption("AutosaveFilename") = NomPdf
.cOption("AutosaveFormat") = 0
.cClearCache
End With
Range("a1", "g32").PrintOut copies:=1, ActivePrinter:="PDFCreator"
Do Until pdfjob.cCountOfPrintjobs = 1
DoEvents
Loop
pdfjob.cPrinterStop = False
Do Until pdfjob.cCountOfPrintjobs = 0
DoEvents
Loop
With pdfjob
.cDefaultPrinter = DefaultPrinter
.cClearCache
.cClose
End With
Set pdfjob = Nothing
Application.DisplayAlerts = False
'Envoi d'un message par pièce jointe
Dim OutlookApp As New Outlook.Application
Dim Mess As Outlook.MailItem, Desti As String
Dim PJ As String, fich As String
' Chemin où se trouvent les fichiers - à modifier
Const Chemin = "f:\1_excel\"
' Ici, code le destinataire
Desti = "aan@gmail.com"
Set OutlookApp = Outlook.Application
fich = Dir("f:\1_excel\" & "*.pdf")
'Do While fich <> ""
Set Mess = OutlookApp.CreateItem(olMailItem)
With Mess
.Attachments.Add Chemin & fich
.Subject = Range("a7").Value & " " & Range("C16").Value & " " & Range("E20").Value
.Body = " Veuillez trouver, en pj, la fiche d'appel de l'agent cité en objet"
.Recipients.Add Desti
.Send
End With
fich = Dir
' Loop
Kill ("f:\1_excel\*.pdf")
ThisWorkbook.Save
ThisWorkbook.Close
End Sub
Voilà, je suis déjà content de mes débuts et je continue...
des problèmes de librairies, je pense..
Merci pour tous ces codes trouvés sur la toile
Meknès
Bonsoir,
juste pour dire merci pour ce code qui m'a été très utile!