Sauvegarde d'un mail avant de l'envoyer

Bonjour ,

Je suis actuellement en train de programmer un vba pour excel 2016 , le but est d'envoyer automatiquement des emails de relance . La partie envoie de mail fonctionne parfaitement mais j'aimerais avant d'envoyer le mail le sauvegarder dans un répertoire pour garder des traces .Pour le moment lorsque je lance le code je sauvegarde un fichier nommé 0 dans mes Documents .

Voici ma partie du code qui envoie le mail :

Sub envoimail()
Dim Messagerie, Msg As Object
Dim SendTo, Entreprise, Copy, Mail_envoi, Fichier_joint As String
SendTo = ActiveCell.Offset(0, 1).Value  ' ici on indique le destinataire du mail
Entreprise = ActiveCell.Offset(0, -3).Value
Copy = "" ' on indique les personnes en copie
Mail_envoi = "Dear Supplier,<br>"
'contenue du mail
Set Messagerie = CreateObject("Outlook.Application")
Set Msg = Messagerie.createitem(0)
Msg.Display ' on affiche le mail ( pour avoir la signature)
Msg.To = SendTo ' on indique a outlook le destinataire
Msg.Cc = Copy  ' on indique les personnes en copie
Msg.Subject = "Quality's Certifcate Request" & " " & Date & " " & Entreprise ' l'objet du mail
Msg.HTMLBody = Mail_envoi & Msg.HTMLBody  'on indique le contenue du mail ( le &html.body est n?cessaire pour l'affichage de la signature)
Msg.SaveAs Filename = "C:\Utilisateurs\" & "\ Bureau\" & Msg.Subject & ".msg"
Msg.Send  ' on envoie le mail
Set Messagerie = Nothing
End Sub

Merci d'avance !

Bonjour,

N'est-il pas plus simple d'activer par defaut la sauvegarde des mails envoyés dans les paramêtres de la messagerie ?

Merci de votre réponse ,

Pour être tout a fait honnête je risque dans le long terme de ne pas être le seul utilisateur de ce fichier et j'aimerais qu'il soit le plus simple possible a utilisé .

Bon petite avancée (ou pas )

Maintenant le message d'erreur m'indique que je n'ai pas" les autorisations nécessaires pour effectuer cette opération"

Pour information la ligne bloquant le code est

 Msg.SaveAs Filename = "C:\Utilisateurs\Bureau" & Msg.Subject & ".msg"

Sub envoimail()
Dim Messagerie, Msg As Object
Dim SendTo, Entreprise, Copy, Mail_envoi, Fichier_joint As String
SendTo = ActiveCell.Offset(0, 1).Value  ' ici on indique le destinataire du mail
Entreprise = ActiveCell.Offset(0, -3).Value
Copy = "" ' on indique les personnes en copie
Mail_envoi = "Dear Supplier,<br>"
'contenue du mail
Set Messagerie = CreateObject("Outlook.Application")
Set Msg = Messagerie.createitem(0)
Msg.Display ' on affiche le mail ( pour avoir la signature)
Msg.To = SendTo ' on indique a outlook le destinataire
Msg.Cc = Copy  ' on indique les personnes en copie
Msg.Subject = "Quality's Certifcate Request" & " " & Date & " " & Entreprise ' l'objet du mail
Msg.HTMLBody = Mail_envoi & Msg.HTMLBody  'on indique le contenue du mail ( le &html.body est n?cessaire pour l'affichage de la signature)
Msg.SaveAs Filename = "C:\Utilisateurs\Bureau" & Msg.Subject & ".msg"
Msg.Send  ' on envoie le mail
Set Messagerie = Nothing
End Sub

Bonsoir,

Aurelagamelle a écrit :

Maintenant le message d'erreur m'indique que je n'ai pas" les autorisations nécessaires pour effectuer cette opération"

Pour information la ligne bloquant le code estCode : Tout sélectionner Msg.SaveAs Filename = "C:\Utilisateurs\Bureau" & Msg.Subject & ".msg"

Pas vraiment surprenant car en général, l'enregistrement sur l'unité C n'est autorisé que pour les dossiers spéciaux. Si vous voulez sauvegarder sur le bureau de l'utilisateur, il faut alors utiliser le dossier spécial correspondant :

Msg.SaveAs Filename= CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\" & Msg.Subject

Pour une sauvegarde dans le dossier "Mes Documents" :

Msg.SaveAs Filename= CreateObject("WScript.Shell").SpecialFolders("MyDocuments") & "\" & Msg.Subject

Bonjour,

J'ai testé votre code mais malheureusement ça me donne un document de type fichier avec comme nom de document 0 et quand j'ouvre le document avec word , ou autre j'obtiens un "texte " rempli de carré et autre .

Bonjour,

J'ai oublié d'ajouter l'extension qui appellera l'application Outlook:

Msg.SaveAs Filename= CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\" & Msg.Subject & ".msg"

Msg.SaveAs Filename= CreateObject("WScript.Shell").SpecialFolders("MyDocuments") & "\" & Msg.Subject & ".msg"

Ce fichier doit être ouvert avec l'application Outlook sinon il est illisible.

Re ,

Le ".msg" ne change rien aux types de fichiers qui est sauvegardé , lorsque j'essaie de l'ouvrir avec Outlook ça m'indique "cette application ne peut pas s'éxécuter sur votre PC .