Répondre à un mail ouvert via VBA
Bonjour à tous,
J'ai un soucis avec mon code, en gros, j'ai un mail sur mon réseau, je récupère des infos sur ce mail pour derrière envoyer un nouveau mail (Expéditeur,Objet, mail d'origine que je mets en pièce jointe dans le nouveau).
![capture d ecran 2023 09 01 154423](https://forum.excel-pratique.com/file/img/1/108781_64f1f38e15d53148280390.png)
Le soucis se pose lorsque le mail en question est ouvert par un des mes commerciaux, je n'ai du coup plus accès à ce mail, plutôt normal car même en manuel via Outlook, on ne peut pas ouvrir deux fois un mail, la "lecture seule" n'existe pas pour un mail.
Je décide donc je résoudre le soucis en réalisant un copie de ce mail sur laquelle je récupère les données et que je supprimerai après. Mais la copie ne fonctionne pas non plus si le mail est ouvert, pourtant en manuel sous Windows j'y arrive sans soucis. Existe-t-il une parade pour cela ?
Voici mon code actuel avec la copie:
'Recherche des informations mail client + objet depuis le mail de demande de devis
'Déclaration des objets
Set OutlookApplication = CreateObject("Outlook.Application")
If Fichier <> vbNullString Then
FileCopy Répertoire & Fichier, Répertoire & "Copie.msg"
Set MailItem = OutlookApplication.Session.OpenSharedItem(Répertoire & "Copie.msg")
NomMail = MailItem.Subject
End If
'Déclaration des objets
Set OutlookApplication = New Outlook.Application
Set MailItem = OutlookApplication.CreateItem(olMailItem)
'If Fichier <> vbNullString Then
MailItem.Attachments.Add Répertoire & "Copie.msg"
'Else
' MsgBox "Le dossier ne contient pas de mail.", vbExclamation, "Erreur - Envoyer_Mail_Chargé_Affaire"
'End If
With MailItem
.To = T2_MailCA 'Destinataire
.Subject = "Offre " & Offre.Cells(T2_Ligne, "A") & " - " & Offre.Cells(T2_Ligne, "L") & " ---> " & NomMail 'Objet du mail 'Objet du mail
.HTMLBody = "<BODY style=font-size:11pt;font-family:Calibri>" & "Bonjour,<br>" & _
"<br>" & _
"Ci-joint la demande de prix : OT" & Offre.Cells(T2_Ligne, "A") & "<br>" & _
"<br>" & _
"Client : " & Offre.Cells(T2_Ligne, "L") & "<br>" & _
"Date de réponse cible : " & Offre.Cells(T2_Ligne, "F") & "<br>" & _
"Lien du dossier: <A href= '" & "file:\\" & Replace(CheminFinalOffre, " ", "%20") & "'>Ctrl + Clic ici</A><br>" & _
"<br>" & _
"Cordialement.</BODY>" & .HTMLBody
Cordialement.
Hello,
Essaye en FSO.
Utilise CopyFile, exemple :
Set fso = CreateObject("Scripting.FileSystemObject")
fso.CopyFile inPath & "\TEST.msg", inPath & "\TEST_Copie.msg"
Salut Rag,
Cela fonctionne nickel. Je ne savais pas que FileCopy
ne fonctionnait pas sur un fichier ouvert. Merci pour ton aide.
Cordialement.