Récupérer l'expediteur, l'objet et le contenu d'un mail
Bonjour le forum,
Je construit en ce moment un ensemble de macro communiquant avec Outlook. Dans l'ensemble j'arrive à avoir des résultats.
Mais il y a un élément sur lequel je bloque et dont je n'arrive à rien.
Via un bouton, j'exécute une macro qui va vérifier dans ma boite de réception si j'ai des mails non lu. Si c'est le cas, alors il les copies dans un dossier d'un répertoire en local ("C:\autre\programme\ etc...) puis récupère leur nom pour les afficher dans un ensemble de cellule sur une feuille "Accueil". Il y a également plusieurs conditions pour remplacer les caractère spéciaux par des "_" car les caractères spéciaux ne sont pas accepté dans le nom des fichiers stockés dans des répertoire physique.
Sub rafraichir_mail()
Dim olApp As Object, NS As Object, Dossier As Object, objFSO As Object
Dim OlExp As Object
Dim myItems As Outlook.Items
Dim myItem As Object
Dim msg As MailItem
a = 18
i = 18
'------------------------------------Accède à la boite de réception outlook--------------------------------------------'
Set olApp = CreateObject("Outlook.Application")
Set OlExp = olApp.ActiveExplorer
Set NS = olApp.GetNamespace("MAPI")
Set Dossier = NS.Folders("mon repertoire outlook").Folders("Boîte de réception")
'--------------------------------Check tous les mails non lu et les ajoute le sujet du mail à la cellule (i, 5)------------------------------------'
For Each Item In Dossier.Items
DoEvents
If (Item.Class = olMail) And (Item.UnRead) Then
Set msg = Item
Cells(i, 5) = msg.Subject
'-------------------------------Remplacement des caractères spéciaux dans les sujets ajoutés-------------------------------------------'
Cells(i, 5) = Replace(Cells(i, 5).Value, ":", "_")
Cells(i, 5) = Replace(Cells(i, 5).Value, "/", "_")
Cells(i, 5) = Replace(Cells(i, 5).Value, "\", "_")
Cells(i, 5) = Replace(Cells(i, 5).Value, "*", "_")
Cells(i, 5) = Replace(Cells(i, 5).Value, "?", "_")
Cells(i, 5) = Replace(Cells(i, 5).Value, "<", "_")
Cells(i, 5) = Replace(Cells(i, 5).Value, ">", "_")
Cells(i, 5) = Replace(Cells(i, 5).Value, "|", "_")
Cells(i, 5) = Replace(Cells(i, 5).Value, """", "_")
'----------------------------------Enregistre le mail dans un répertoire local avec pour nom le sujet du mail sans caractère spéciaux-----------------'
a = Cells(i, 5).Value
Chemin = "C:\Documents\Techniques\Desktop\Autre\support\mail\"
NomFichier = a & ".msg"
Item.SaveAs Chemin & NomFichier
'----------------------------------------Sélectionne la cellule (i, 5) et ajoute un lien Hypertexte vers le mail associé dans le document du répertoire-------'
Cells(i, 5).Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="mail\" & a & ".msg", TextToDisplay:=a
i = i + 5
End If
Next
End Sub
Maintenant que mes cellules ont récupéré le même nom que mes mails dans mon dossier sur le répertoire. Je souhaite ajouté une macro où quand je fais un simple click sur l'une de mes cellules où se trouve le nom de l'un des mails (Range("E18:E173")), celui-ci récupère l'expéditeur, l'objet et le contenu du mail associé pour ensuite aller les mettre dans trois cellules à part :
BO18 = l'expediteur (son nom ou son mail, peu importe)
BO23 = L'objet du mail
AY28 = Le contenu du mail
Si quelqu'un a une idée je suis preneur.
bonjour,
récupère ces infos dans ta macro qui exploite les mails non lus. (msg.subject, msg.to, msg.body ou msg.htmlbody dépendant de msg.bodyformat)