Savoir si un mail reçu outlook a déjà eu une réponse

Bonjour,

je cherche à faire un outil "plan de travail" qui lit une boites mail outlook, et rassemble dans un fichier excel la liste des messages, triés par date et avec quelques infos: caractère d'urgence, catégorie associée, etc.

j'aurais besoin de savoir si le message a déjà fait l'objet d'une réponse, ou pas.

Dans les fonctions Outlook VBA, j'arrive pas à trouver l'attribut, pour savoir si un mail reçu a déjà eu une réponse, un transfert ou autre.

Merci d'avance pour votre aide.

Bonjour,

pour moi une réponse reçue est un mail comme un autre. Pas sûr qu'il ait un marquage particulier.

Donc à part rechercher si tu trouves le même objet précédé de "RE: " je ne vois pas.

Et encore, à condition que le répondeur n'ait pas édité l'objet.

eric

Bonjour,

Merci pour votre réponse.

En fait par rapport au "Re", ça marche, mais il faudrait savoir si le dernier email reçu a déjà eu une réponse, ou un transfert... Car c'est possible de recevoir un mail avec "Re" en objet, sans y avoir répondu, ou sans avoir transférer cet email

Ci dessous une solution, que je n'arrive pas à faire marcher .. :

" Dim dernier_verbe As String, date_dernier_verbe As Date

Const PR_LAST_VERB_EXECUTED =

"http://schemas.microsoft.com/mapi/proptag/0x10810003"

Const PR_LAST_VERB_EXECUTION_TIME =

"http://schemas.microsoft.com/mapi/proptag/0x10820040"

dernier_verbe =

email.PropertyAccessor.GetProperty(PR_LAST_VERB_EXECUTED)

date_dernier_verbe =

email.PropertyAccessor.GetProperty(PR_LAST_VERB_EXECUTION_TIME) "

Cordialement,

Bastien

Désolé je ne pratique pas VBA Outlook.

Tu devrais voir s'il n'y a pas un forum plus spécialisé, ce n'est plus vraiment un pb excel.

eric

Bonjour,

Voir ma réponse à ce post

https://forum.excel-pratique.com/viewtopic.php?f=2&t=121121

Qu'est-ce qui ne fonctionne pas ?

Bonjour merci pour vos réponses,

En fait lorsque je colle cette partie dans ma macro, ça bug au niveau du "const "

Je vous dirai plus en détail demain matin.

Est ce qu'il y a quelque chose à modifier dans votre solution, il y a des parties à personnaliser ? ou il faut tout coller sans rien modifier ?

Cordialement,

Bastien

Vous devez tout coller sans modification

 
    Dim dernier_verbe As String, date_dernier_verbe As Date
    Const PR_LAST_VERB_EXECUTED As String = "http://schemas.microsoft.com/mapi/proptag/0x10810003"
    Const PR_LAST_VERB_EXECUTION_TIME As String = "http://schemas.microsoft.com/mapi/proptag/0x10820040"

    dernier_verbe = Email.PropertyAccessor.GetProperty(PR_LAST_VERB_EXECUTED)
    date_dernier_verbe = Email.PropertyAccessor.GetProperty(PR_LAST_VERB_EXECUTION_TI)

Bonjour,

Je viens d'essayer et ça me met erreur d'execution 424, objet requis

Lorsque je clique sur Débogage, ça me surligne en jaune toute la ligne dernier_verbe =Email.propertyAccessor....

:/

Pour mieux comprendre, je vous colle la macro en dessous. En fait c'est la ligne en gras qui bloque, car il n'y a pas d'objet requis ...

Function ExtractMessageBoite(NomBoite As String, NomRep As String, codeBoite As String, RepCopieMail As String, Optional NomSousRep As String)

Dim OLapp As Outlook.Application

Dim OLspace As Outlook.Namespace

Dim OLinbox As Outlook.MAPIFolder

Dim FileName As String

Dim Item As Object

Dim NoFile As Integer

Dim stTextInput As String

Dim xlApp As Excel.Application

Dim xlSheet As Excel.Worksheet

Dim xlBook As Excel.Workbook

Dim I As Integer

Set OLapp = CreateObject("Outlook.application")

Set OLspace = OLapp.GetNamespace("MAPI")

Set olNs = OLapp.GetNamespace("MAPI")

For Each Item In Fldr.Items

If C_page > 0 Then

If Item.HTMLBody = "" Then

Cells(ligne, C_page) = " "

Else

Dim dernier_verbe As Object, date_dernier_verbe As Date

Const PR_LAST_VERB_EXECUTED As string = "http://schemas.microsoft.com/mapi/proptag/0x10810003"

Const PR_LAST_VERB_EXECUTION_TIME As String = "http://schemas.microsoft.com/mapi/proptag/0x10820040"

dernier_verbe = Email.PropertyAccessor.GetProperty(PR_LAST_VERB_EXECUTED)

date_dernier_verbe = Email.PropertyAccessor.GetProperty(PR_LAST_VERB_EXECUTION_TIME)

Cells(ligne, 10) = dernier_verbe

End If

End If

Next Item

Set xlSheet = Nothing

Set xlBook = Nothing

Set xlApp = Nothing

Set OLapp = Nothing

Set OLspace = Nothing

Set OLinbox = Nothing

End Function

Bonjour,

D'abord, quelques remarques :

1- votre code ne correspond pas à une fonction mais à une procédure. Une fonction donne toujours un résultat :

résultat = ExtractMessageBoite(NomBoite, NomRep, CodeBoite, RepCopieMail)

2- Je ne vois pas très bien ce que viennent faire ces définitions

    Dim xlApp As Excel.Application
    Dim xlSheet As Excel.Worksheet
    Dim xlBook As Excel.Workbook

3- merci de communiquer votre code en utilisant la balise "</>"

ci-dessous exemple de code :

Sub test()
    Dim NomBoite As String, NomRep As String, CodeBoite As String, RepCopieMail As String

    NomBoite = "xxxxxxxx@yyyyyyy.zzz"  'compte de messagerie
    CodeBoite = "Boîte de Réception"  'ou "InBox" si anglo-saxon
    Call ExtractMessageBoite(NomBoite, NomRep, CodeBoite, RepCopieMail)

End Sub

Sub ExtractMessageBoite(NomBoite As String, NomRep As String, CodeBoite As String, RepCopieMail As String, Optional NomSousRep As String)
    Dim OLapp As Outlook.Application
    Dim OLNs As Outlook.Namespace
    Dim Dossier As Outlook.MAPIFolder
    Dim FileName As String
    Dim emails As Outlook.Items, email As Outlook.MailItem

    Dim NoFile As Integer
    Dim stTextInput As String

    Dim xlApp As Excel.Application
    Dim xlSheet As Excel.Worksheet
    Dim xlBook As Excel.Workbook

    Dim I As Integer

    Set OLapp = CreateObject("Outlook.application")
    Set OLNs = OLapp.GetNamespace("MAPI")

    'balayage Dossiers Outlook
    For Each Dossier In OLNs.Folders
        If Dossier.Name = NomBoite Then
            'assignation emails de la boîte de réception du Compte de messagerie
            Set emails = Dossier.Folders(CodeBoite).Items
            Exit For
        End If
    Next Dossier

    For Each email In emails

        If C_page > 0 Then
            If email.HTMLBody = "" Then
                Cells(ligne, C_page) = " "
            Else
                Dim dernier_verbe As String, date_dernier_verbe As Date
                Const PR_LAST_VERB_EXECUTED As String = "http://schemas.microsoft.com/mapi/proptag/0x10810003"
                Const PR_LAST_VERB_EXECUTION_TIME As String = "http://schemas.microsoft.com/mapi/proptag/0x10820040"

                dernier_verbe = email.PropertyAccessor.GetProperty(PR_LAST_VERB_EXECUTED)
                If dernier_verbe <> "0" Then date_dernier_verbe = email.PropertyAccessor.GetProperty(PR_LAST_VERB_EXECUTION_TIME)
                Cells(ligne, "J") = dernier_verbe
            End If
        End If

    Next email

    Set xlSheet = Nothing
    Set xlBook = Nothing
    Set xlApp = Nothing

    Set OLapp = Nothing
    Set OLNs = Nothing

End Sub

Re bonjour,

D'abord je vous remercie beaucoup pour votre aide réactif ..

Lorsque je test cette macro, ça me dit "Erreur d'exécution 424,objet requis"

ça me surligne la ligne For Each email In emails

Voici le code ci-dessous

< Sub test()

Dim NomBoite As String, NomRep As String, CodeBoite As String, RepCopieMail As String

NomBoite = "adressemail@entreprise.com" 'compte de messagerie

CodeBoite = "Boîte de Réception" 'ou "InBox" si anglo-saxon

Call ExtractMessageBoite(NomBoite, NomRep, CodeBoite, RepCopieMail)

End Sub

Sub ExtractMessageBoite(NomBoite As String, NomRep As String, CodeBoite As String, RepCopieMail As String, Optional NomSousRep As String)

Dim OLapp As Outlook.Application

Dim OLNs As Outlook.Namespace

Dim Dossier As Outlook.MAPIFolder

Dim FileName As String

Dim emails As Outlook.Items, email As Outlook.MailItem

Dim NoFile As Integer

Dim stTextInput As String

Dim xlApp As Excel.Application

Dim xlSheet As Excel.Worksheet

Dim xlBook As Excel.Workbook

Dim I As Integer

Set OLapp = CreateObject("Outlook.application")

Set OLNs = OLapp.GetNamespace("MAPI")

'balayage Dossiers Outlook

For Each Dossier In OLNs.Folders

If Dossier.Name = NomBoite Then

'assignation emails de la boîte de réception du Compte de messagerie

Set emails = Dossier.Folders(CodeBoite).Items

Exit For

End If

Next Dossier

For Each email In emails

Dim dernier_verbe As String, date_dernier_verbe As Date

Const PR_LAST_VERB_EXECUTED As String = "http://schemas.microsoft.com/mapi/proptag/0x10810003"

Const PR_LAST_VERB_EXECUTION_TIME As String = "http://schemas.microsoft.com/mapi/proptag/0x10820040"

dernier_verbe = email.PropertyAccessor.GetProperty(PR_LAST_VERB_EXECUTED)

date_dernier_verbe = email.PropertyAccessor.GetProperty(PR_LAST_VERB_EXECUTION_TIME)

Cells(ligne, 10) = dernier_verbe

Next email

Set xlSheet = Nothing

Set xlBook = Nothing

Set xlApp = Nothing

Set OLapp = Nothing

Set OLNs = Nothing

End Sub

/>

PS : J'ai mis les balises dans le commentaire précédant ...

La valeur de Cells(ligne, 10) est égale à "erreur définie par l'application ou par l'objet"

Si vous n'avez assigné aucune valeur à la variable "ligne", par défaut elle est égale à zéro. Or ligne doit être au minimum égal à 1.

Par ailleurs, Cells(ligne, "J") est plus parlant que Cells(ligne, 10).

Pour bien afficher le code:

1- le sélectionner

2- cliquer sur la balise "</>"

NB : La signification des verbes se trouve sur cette page

https://docs.microsoft.com/en-us/office/client-developer/outlook/mapi/pidtaglastverbexecuted-canonical-property

Lorsque je test cette macro, ça me dit "Erreur d'exécution 424,objet requis"

ça me surligne la ligne For Each email In emails

cela signifie que le compte de messagerie n'a pas été trouvé ou que le code de la boîte est incorrect.

Pour tenir compte de ce cas :

  
    'balayage Dossiers Outlook
    For Each Dossier In OLNs.Folders
        If Dossier.Name = NomBoite Then
            'assignation emails de la boîte de réception du Compte de messagerie
            Set emails = Dossier.Folders(CodeBoite).Items
            Exit For
        End If
    Next Dossier
    If emails Is Nothing Then Exit Sub

    For Each email In emails

Re bonjour,

Lorsque je prend en compte le Exit, quand je lance la macro ça ne fait rien ...

Mais quand j'enlève le Exit, ça me remet l'erreur 424 objet requis, en surlignant

"For Each email In emails"

La valeur "email" = Nothing

La valeur "emails" = Nothing aussi

Je ne comprend pas car j'ai bien mis la bonne adresse mail............

e ne comprend pas car j'ai bien mis la bonne adresse mail....

Et le code de la boîte est en français ou en anglais ?

"Boîte de Réception" ou "Inbox"

Vous pouvez vérifier dans Outlook le nom du dossier correspondant à votre compte.

Dans l'onglet "Courrier":

1- sélectionner le dossier correspondant à votre compte

2- clic droit --> clic gauche sur propriétés du fichier de données

3- le nom du dossier est indiqué juste sous l'onglet "Général"

tout est en français ........

Avec toujours la meme erreur "424 erreur d'execution objet requis"

en surlignant la ligne "For Each email In emails"

Email = Nothing, et Emails = Nothing aussi ..... Je ne comprend rien car c'est bel et bien la bonne adresse mail, c'est bien le bon code en français pour la boite de réception.... je suis complètement perdu

Sub test()
    Dim NomBoite As String, NomRep As String, CodeBoite As String, RepCopieMail As String

    NomBoite = "entreprise@entreprise.com"  'compte de messagerie
    CodeBoite = "Boîte de Réception"  'ou "InBox" si anglo-saxon
    Call ExtractMessageBoite(NomBoite, NomRep, CodeBoite, RepCopieMail)

End Sub

Sub ExtractMessageBoite(NomBoite As String, NomRep As String, CodeBoite As String, RepCopieMail As String, Optional NomSousRep As String)
    Dim OLapp As Outlook.Application
    Dim OLNs As Outlook.Namespace
    Dim Dossier As Outlook.MAPIFolder
    Dim FileName As String
    Dim emails As Outlook.Items, email As Outlook.MailItem

    Dim NoFile As Integer
    Dim stTextInput As String

    Dim xlApp As Excel.Application
    Dim xlSheet As Excel.Worksheet
    Dim xlBook As Excel.Workbook

    Dim I As Integer

    Set OLapp = CreateObject("Outlook.application")
    Set OLNs = OLapp.GetNamespace("MAPI")

    'balayage Dossiers Outlook
    For Each Dossier In OLNs.Folders
        If Dossier.Name = NomBoite Then
            'assignation emails de la boîte de réception du Compte de messagerie
            Set emails = Dossier.Folders(CodeBoite).Items
            Exit For
        End If
    Next Dossier

    For Each email In emails

                Dim dernier_verbe As String, date_dernier_verbe As Date
                Const PR_LAST_VERB_EXECUTED As String = "http://schemas.microsoft.com/mapi/proptag/0x10810003"
                Const PR_LAST_VERB_EXECUTION_TIME As String = "http://schemas.microsoft.com/mapi/proptag/0x10820040"

                dernier_verbe = email.PropertyAccessor.GetProperty(PR_LAST_VERB_EXECUTED)
                If dernier_verbe <> "0" Then date_dernier_verbe = email.PropertyAccessor.GetProperty(PR_LAST_VERB_EXECUTION_TIME)
                Cells(ligne, "J") = dernier_verbe

    Next email

    Set xlSheet = Nothing
    Set xlBook = Nothing
    Set xlApp = Nothing

    Set OLapp = Nothing
    Set OLNs = Nothing

End Sub

Je ne comprend rien car c'est bel et bien la bonne adresse mail, c'est bien le bon code en français pour la boite de réception...

Vérifier dans Outlook le nom du dossier correspondant à votre compte de messagerie

Dans l'onglet "Courrier":

1- sélectionner le dossier correspondant à votre compte

2- clic droit --> clic gauche sur propriétés du fichier de données

3- le nom du dossier est indiqué juste sous l'onglet "Général"

1000 Merci !!!

Lorsque je lance la macro, il n'y a plus aucune erreur!

Mais le résultat final, c'est "13/04/1900 00:00:00" dans la cellule J3

Je ne comprend pas vraiment ce résultat, est ce bien pour savoir si un mail reçu a déjà subis une réponse, ou un transfert ?

les résultats sur la cellule changent très rapidement, pour au final avoir "13/04/1900 00:00:00"

Les résultats changent dans la même cellule

Rechercher des sujets similaires à "savoir mail recu outlook deja reponse"