Extraire des informations d'un mail Outlook
Bonjour à tous,
Mon objectif premier était d'extraire des informations (objet, date, contenu,...) lorsque je recevais un mail sur mon Outlook.
Ce que j'ai déjà fait marche pour tous mes mails et s'exécute sur tous ceux que j'ai déjà reçu. Je n'arrive pas à faire en sorte que cela s"exécute uniquement sur ceux qui arrivent.
Aussi, je veux que ça le fasse uniquement pour un destinataire particulier (disons exemple@exemple.com) et que ça cherche sur une BAL et non pas sur ma boite perso.
J'espère avoir été clair dans mon explication. Je vous glisse le code que j'ai déjà écrit.
Par avance merci beaucoup.
Bien cordialement,
William
Sub DataOutlook()
Set olApp = CreateObject("Outlook.Application")
Set olns = olApp.GetNamespace("MAPI")
Set olxFolder = olns.GetDefaultFolder(6)
Sheets("Litmessagerie").Select
On Error Resume Next
n = 2
For Each i In olxFolder.Items
Cells(n, 1) = i.Subject
Cells(n, 2).ClearComments
Cells(n, 2).AddComment Text:=Replace(i.Body, Chr(13), "")
Cells(n, 2).Comment.Shape.Height = 150
Cells(n, 2).Comment.Shape.Width = 300
Cells(n, 3) = i.SenderName
Cells(n, 4) = i.CreationTime
n = n + 1
Next
End Sub
Hello,
s'exécute sur tous ceux que j'ai déjà reçu. Je n'arrive pas à faire en sorte que cela s"exécute uniquement sur ceux qui arrivent.
Quelle est la différence entre des mails "déjà reçus" et des mails qui "arrivent" ???
Bonsoir,
Je me suis mal exprimé. Je pense qu'il est plus simple que je puisse mettre une date précise dans le code qui ferait que j'ai tous les mails après cette date. Vous auriez une idée?
Merci d'avance
Hello,
A tester :
Sub DataOutlook()
Set olApp = CreateObject("Outlook.Application")
Set olns = olApp.GetNamespace("MAPI")
Set olxFolder = olns.GetDefaultFolder(6)
Sheets("Litmessagerie").Select
On Error Resume Next
n = 2
For Each i In olxFolder.Items
if i.ReceivedTime > "01/01/2021" and i.SenderEmailAddress = "TOTOL'HARICOT@gmaul.com" then
Cells(n, 1) = i.Subject
Cells(n, 2).ClearComments
Cells(n, 2).AddComment Text:=Replace(i.Body, Chr(13), "")
Cells(n, 2).Comment.Shape.Height = 150
Cells(n, 2).Comment.Shape.Width = 300
Cells(n, 3) = i.SenderName
Cells(n, 4) = i.CreationTime
n = n + 1
end if
Next
End Sub